{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, RankNTypes, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} module SP2GP.Relations ( Rels, (===), for', in', rels, ) where import qualified SemigroupPresentation as SP import qualified GroupPresentation as GP import Format import Containers import Lens import qualified Control.Monad.Reader as R import qualified Control.Monad.List as LT import Control.Monad (guard, forM, forM_) import Control.Monad.Trans (lift) import Control.Lens (each) import Data.List (find) import Data.Foldable (fold) import Data.Semigroup (stimes) type Rels = [Rel] data Rel = JustRel String String | forall v c. RangeClass v c => ForBlock (Range v c) Rels data Range v c = Range v c type SetGetter a = SP.SPGetting (Set a) (===) :: String -> String -> Rel === :: String -> String -> Rel (===) = String -> String -> Rel JustRel for' :: RangeClass v c => Range v c -> Rels -> Rel for' :: Range v c -> Rels -> Rel for' = Range v c -> Rels -> Rel forall v c. RangeClass v c => Range v c -> Rels -> Rel ForBlock in' :: RangeClass v c => v -> c -> Range v c in' :: v -> c -> Range v c in' = v -> c -> Range v c forall v c. v -> c -> Range v c Range type LocalReader = R.ReaderT ReplaceRules ( R.ReaderT GP.GeneratorsDescr ( R.ReaderT SP.SemigroupPresentation Maybe ) ) liftSP :: R.ReaderT SP.SemigroupPresentation Maybe a -> LocalReader a liftSP :: ReaderT SemigroupPresentation Maybe a -> LocalReader a liftSP = ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) a -> LocalReader a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) a -> LocalReader a) -> (ReaderT SemigroupPresentation Maybe a -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) a) -> ReaderT SemigroupPresentation Maybe a -> LocalReader a forall b c a. (b -> c) -> (a -> b) -> a -> c . ReaderT SemigroupPresentation Maybe a -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift type ReplaceRules = [ReplaceRule] type ReplaceRule = ([String], [[GP.GWord]]) consistRR :: String -> ReplaceRule -> Bool consistRR :: String -> ReplaceRule -> Bool consistRR String g ReplaceRule rr = String g String -> [String] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` ReplaceRule -> [String] forall a b. (a, b) -> a fst ReplaceRule rr type ReplaceAtom = (String, GP.GWord) consistRA :: String -> ReplaceAtom -> Bool consistRA :: String -> ReplaceAtom -> Bool consistRA String g ReplaceAtom ra = ReplaceAtom -> String forall a b. (a, b) -> a fst ReplaceAtom ra String -> String -> Bool forall a. Eq a => a -> a -> Bool == String g rels :: MonadFail m => Rels -> GP.GeneratorsDescr -> SP.SemigroupPresentation -> m GP.Relations rels :: Rels -> GeneratorsDescr -> SemigroupPresentation -> m Relations rels = ((m Relations -> (Relations -> m Relations) -> Maybe Relations -> m Relations forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> m Relations forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Can't create relations") Relations -> m Relations forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Relations -> m Relations) -> (SemigroupPresentation -> Maybe Relations) -> SemigroupPresentation -> m Relations forall b c a. (b -> c) -> (a -> b) -> a -> c .) ((SemigroupPresentation -> Maybe Relations) -> SemigroupPresentation -> m Relations) -> (GeneratorsDescr -> SemigroupPresentation -> Maybe Relations) -> GeneratorsDescr -> SemigroupPresentation -> m Relations forall b c a. (b -> c) -> (a -> b) -> a -> c .) ((GeneratorsDescr -> SemigroupPresentation -> Maybe Relations) -> GeneratorsDescr -> SemigroupPresentation -> m Relations) -> (Rels -> GeneratorsDescr -> SemigroupPresentation -> Maybe Relations) -> Rels -> GeneratorsDescr -> SemigroupPresentation -> m Relations forall b c a. (b -> c) -> (a -> b) -> a -> c . (ReaderT SemigroupPresentation Maybe Relations -> SemigroupPresentation -> Maybe Relations forall r (m :: * -> *) a. ReaderT r m a -> r -> m a R.runReaderT (ReaderT SemigroupPresentation Maybe Relations -> SemigroupPresentation -> Maybe Relations) -> (GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations) -> GeneratorsDescr -> SemigroupPresentation -> Maybe Relations forall b c a. (b -> c) -> (a -> b) -> a -> c .) ((GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations) -> GeneratorsDescr -> SemigroupPresentation -> Maybe Relations) -> (Rels -> GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations) -> Rels -> GeneratorsDescr -> SemigroupPresentation -> Maybe Relations forall b c a. (b -> c) -> (a -> b) -> a -> c . ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations -> GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations forall r (m :: * -> *) a. ReaderT r m a -> r -> m a R.runReaderT (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations -> GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations) -> (Rels -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations) -> Rels -> GeneratorsDescr -> ReaderT SemigroupPresentation Maybe Relations forall b c a. (b -> c) -> (a -> b) -> a -> c . (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations -> [ReplaceRule] -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations) -> [ReplaceRule] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations forall a b c. (a -> b -> c) -> b -> a -> c flip ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations -> [ReplaceRule] -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations forall r (m :: * -> *) a. ReaderT r m a -> r -> m a R.runReaderT [] (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations) -> (Rels -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations) -> Rels -> ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) Relations forall b c a. (b -> c) -> (a -> b) -> a -> c . Rels -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations rels_ rels_ :: Rels -> LocalReader GP.Relations rels_ :: Rels -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations rels_ Rels rs = [Relation] -> Relations forall c v. UnsafeListable c v => [v] -> c fromList ([Relation] -> Relations) -> ([[Relation]] -> [Relation]) -> [[Relation]] -> Relations forall b c a. (b -> c) -> (a -> b) -> a -> c . [[Relation]] -> [Relation] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[Relation]] -> Relations) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Relation]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Rel -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation]) -> Rels -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Relation]] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Rel -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] rel_ Rels rs rel_ :: Rel -> LocalReader [GP.Relation] rel_ :: Rel -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] rel_ (JustRel String ew1 String ew2) = ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] forall (m :: * -> *) a. ListT m a -> m [a] LT.runListT (ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation]) -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] forall a b. (a -> b) -> a -> b $ do let es1 :: [String] es1 = String -> [String] words String ew1 es2 :: [String] es2 = String -> [String] words String ew2 (EWord ews1, [ReplaceAtom] srrs) <- ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom]) forall (m :: * -> *) a. m [a] -> ListT m a LT.ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom])) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom]) forall a b. (a -> b) -> a -> b $ [String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [String] es1 [] (EWord ews2, [ReplaceAtom] _) <- ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom]) forall (m :: * -> *) a. m [a] -> ListT m a LT.ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom])) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) (EWord, [ReplaceAtom]) forall a b. (a -> b) -> a -> b $ [String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [String] es2 [ReplaceAtom] srrs Relation -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation forall (m :: * -> *) a. Monad m => a -> m a return (Relation -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation) -> Relation -> ListT (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe))) Relation forall a b. (a -> b) -> a -> b $ EWord -> EWord -> Relation GP.relation EWord ews1 EWord ews2 rel_ (ForBlock Range v c rg Rels rs) = do ReplaceRule newRule <- Range v c -> LocalReader ReplaceRule forall v c. RangeClass v c => Range v c -> LocalReader ReplaceRule range_ Range v c rg ([ReplaceRule] -> [ReplaceRule]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a R.local (ReplaceRule newRuleReplaceRule -> [ReplaceRule] -> [ReplaceRule] forall a. a -> [a] -> [a] :) (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] forall a b. (a -> b) -> a -> b $ Relations -> [Relation] forall c v. Listable c v => c -> [v] toList (Relations -> [Relation]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Relation] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Rels -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Relations rels_ Rels rs class RangeClass v c where range_ :: Range v c -> LocalReader ReplaceRule instance RangeClass String (SetGetter String) where range_ :: Range String (SetGetter String) -> LocalReader ReplaceRule range_ (Range String str SetGetter String strGetter) = do let fs' :: [String] fs' = String -> [String] words String str Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall a b. (a -> b) -> a -> b $ [String] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [String] fs' Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 1 let f' :: String f' = [String] -> String forall a. [a] -> a head [String] fs' TaggedFormat f :: TaggedFormat <- String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) TaggedFormat forall f (m :: * -> *). (Format f, MonadFail m) => String -> m f format String f' Set String strSet <- ReaderT SemigroupPresentation Maybe (Set String) -> LocalReader (Set String) forall a. ReaderT SemigroupPresentation Maybe a -> LocalReader a liftSP (ReaderT SemigroupPresentation Maybe (Set String) -> LocalReader (Set String)) -> ReaderT SemigroupPresentation Maybe (Set String) -> LocalReader (Set String) forall a b. (a -> b) -> a -> b $ SetGetter String -> ReaderT SemigroupPresentation Maybe (Set String) forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view SetGetter String strGetter let strList :: [String] strList = Set String -> [String] forall c v. Listable c v => c -> [v] toList Set String strSet [Generator] gs <- (String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ ([String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator]) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall a b. (a -> b) -> a -> b $ TaggedFormat -> String -> String forall f i. Apply f i => f -> i -> String apply TaggedFormat f (String -> String) -> [String] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] strList ReplaceRule -> LocalReader ReplaceRule forall (m :: * -> *) a. Monad m => a -> m a return ([TaggedFormat -> String forall f. Apply f () => f -> String format2str TaggedFormat f], ([Generator] -> [[Generator]] forall (f :: * -> *) a. Applicative f => a -> f a pure([Generator] -> [[Generator]]) -> (Generator -> [Generator]) -> Generator -> [[Generator]] forall b c a. (b -> c) -> (a -> b) -> a -> c .Generator -> [Generator] forall (f :: * -> *) a. Applicative f => a -> f a pure) (Generator -> [[Generator]]) -> [Generator] -> [[[Generator]]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Generator] gs) instance RangeClass Rel (SetGetter SP.StrRelation) where range_ :: Range Rel (SetGetter StrRelation) -> LocalReader ReplaceRule range_ (Range (ForBlock Range v c _ Rels _) SetGetter StrRelation _) = String -> LocalReader ReplaceRule forall (m :: * -> *) a. MonadFail m => String -> m a fail String "ForBlock can't be used into Range definition" range_ (Range (JustRel String gw1 String gw2) SetGetter StrRelation relGetter) = do let pgw :: Pair String pgw = (String, String) -> Pair String forall a. (a, a) -> Pair a Pair (String gw1, String gw2) Pair [MaybeTaggedFormat] pfs :: Pair [MaybeTaggedFormat] <- (String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [MaybeTaggedFormat]) -> Pair String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [MaybeTaggedFormat]) forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ((String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) MaybeTaggedFormat) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [MaybeTaggedFormat] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) MaybeTaggedFormat forall f (m :: * -> *). (Format f, MonadFail m) => String -> m f format ([String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [MaybeTaggedFormat]) -> (String -> [String]) -> String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [MaybeTaggedFormat] forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [String] words) Pair String pgw Pair [MaybeTaggedFormat] -> ([MaybeTaggedFormat] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ Pair [MaybeTaggedFormat] pfs (([MaybeTaggedFormat] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> ([MaybeTaggedFormat] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall a b. (a -> b) -> a -> b $ \[MaybeTaggedFormat] fs -> Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall a b. (a -> b) -> a -> b $ ((MaybeTaggedFormat, MaybeTaggedFormat) -> Bool) -> [(MaybeTaggedFormat, MaybeTaggedFormat)] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (\(MaybeTaggedFormat f1, MaybeTaggedFormat f2) -> MaybeTaggedFormat -> Bool forall f. MaybeFormat f -> Bool isFormat MaybeTaggedFormat f1 Bool -> Bool -> Bool || MaybeTaggedFormat -> Bool forall f. MaybeFormat f -> Bool isFormat MaybeTaggedFormat f2) ([(MaybeTaggedFormat, MaybeTaggedFormat)] -> Bool) -> [(MaybeTaggedFormat, MaybeTaggedFormat)] -> Bool forall a b. (a -> b) -> a -> b $ [MaybeTaggedFormat] -> [MaybeTaggedFormat] -> [(MaybeTaggedFormat, MaybeTaggedFormat)] forall a b. [a] -> [b] -> [(a, b)] zip [MaybeTaggedFormat] fs ([MaybeTaggedFormat] -> [MaybeTaggedFormat] forall a. [a] -> [a] tail [MaybeTaggedFormat] fs) Set StrRelation relSet <- ReaderT SemigroupPresentation Maybe (Set StrRelation) -> LocalReader (Set StrRelation) forall a. ReaderT SemigroupPresentation Maybe a -> LocalReader a liftSP (ReaderT SemigroupPresentation Maybe (Set StrRelation) -> LocalReader (Set StrRelation)) -> ReaderT SemigroupPresentation Maybe (Set StrRelation) -> LocalReader (Set StrRelation) forall a b. (a -> b) -> a -> b $ SetGetter StrRelation -> ReaderT SemigroupPresentation Maybe (Set StrRelation) forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view SetGetter StrRelation relGetter let relList :: [StrRelation] relList = Set StrRelation -> [StrRelation] forall c v. Listable c v => c -> [v] toList Set StrRelation relSet [[[Generator]]] gws <- [StrRelation] -> (StrRelation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[[Generator]]] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM [StrRelation] relList ((StrRelation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[[Generator]]]) -> (StrRelation -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[[Generator]]] forall a b. (a -> b) -> a -> b $ \StrRelation rel -> (\[MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] f -> (Pair [[Generator]] -> [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Pair [[Generator]] -> [[Generator]] forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall a b. (a -> b) -> a -> b $ Pair (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]]) forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence (Pair (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]])) -> Pair (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) (Pair [[Generator]]) forall a b. (a -> b) -> a -> b $ [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] f ([MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> Pair [MaybeTaggedFormat] -> Pair ([String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Pair [MaybeTaggedFormat] pfs Pair ([String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> StrRelation -> Pair (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> StrRelation rel) (([MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ([MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall a b. (a -> b) -> a -> b $ \[MaybeTaggedFormat] fs' [String] gs' -> [String] -> [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] go [] [MaybeTaggedFormat] fs' [String] gs' let fs :: [String] fs = StrRelation -> [String] forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m fold (StrRelation -> [String]) -> StrRelation -> [String] forall a b. (a -> b) -> a -> b $ (([MaybeTaggedFormat] -> [String]) -> Pair [MaybeTaggedFormat] -> StrRelation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap(([MaybeTaggedFormat] -> [String]) -> Pair [MaybeTaggedFormat] -> StrRelation) -> ((MaybeTaggedFormat -> String) -> [MaybeTaggedFormat] -> [String]) -> (MaybeTaggedFormat -> String) -> Pair [MaybeTaggedFormat] -> StrRelation forall b c a. (b -> c) -> (a -> b) -> a -> c .(MaybeTaggedFormat -> String) -> [MaybeTaggedFormat] -> [String] forall a b. (a -> b) -> [a] -> [b] map) MaybeTaggedFormat -> String forall f. Apply f () => f -> String format2str Pair [MaybeTaggedFormat] pfs ReplaceRule -> LocalReader ReplaceRule forall (m :: * -> *) a. Monad m => a -> m a return ([String] fs, [[[Generator]]] gws) where go :: [String] -> [MaybeTaggedFormat] -> [String] -> LocalReader [GP.GWord] go :: [String] -> [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] go [String] _ [] [] = [[Generator]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (m :: * -> *) a. Monad m => a -> m a return [] go [String] _ [JustString String _] [String] gs = do [Generator] gw <- (String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ [String] gs [[Generator]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (m :: * -> *) a. Monad m => a -> m a return [[Generator] gw] go [String] acc fs :: [MaybeTaggedFormat] fs@((JustString String _):(JustFormat TaggedFormat f):[MaybeTaggedFormat] fs_) (String g:[String] gs) | TaggedFormat -> String -> Bool forall f r. Match f r => f -> String -> r match TaggedFormat f String g = do [Generator] gw1' <- (String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ ([String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator]) -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall a b. (a -> b) -> a -> b $ [String] -> [String] forall a. [a] -> [a] reverse [String] acc [Generator] gw2' <- Generator -> [Generator] forall (f :: * -> *) a. Applicative f => a -> f a pure (Generator -> [Generator]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ String g ([Generator] gw1'[Generator] -> [[Generator]] -> [[Generator]] forall a. a -> [a] -> [a] :) ([[Generator]] -> [[Generator]]) -> ([[Generator]] -> [[Generator]]) -> [[Generator]] -> [[Generator]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ([Generator] gw2'[Generator] -> [[Generator]] -> [[Generator]] forall a. a -> [a] -> [a] :) ([[Generator]] -> [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] -> [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] go [] [MaybeTaggedFormat] fs_ [String] gs | Bool otherwise = [String] -> [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] go (String gString -> [String] -> [String] forall a. a -> [a] -> [a] :[String] acc) [MaybeTaggedFormat] fs [String] gs go [String] _ ((JustFormat TaggedFormat f):[MaybeTaggedFormat] fs) (String g:[String] gs) = do Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) ()) -> Bool -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) () forall a b. (a -> b) -> a -> b $ TaggedFormat -> String -> Bool forall f r. Match f r => f -> String -> r match TaggedFormat f String g [Generator] gw <- Generator -> [Generator] forall (f :: * -> *) a. Applicative f => a -> f a pure (Generator -> [Generator]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [Generator] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ String g ([Generator] gw[Generator] -> [[Generator]] -> [[Generator]] forall a. a -> [a] -> [a] :) ([[Generator]] -> [[Generator]]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] -> [MaybeTaggedFormat] -> [String] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] go [] [MaybeTaggedFormat] fs [String] gs go [String] _ [MaybeTaggedFormat] _ [String] _ = String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[Generator]] forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Something goes wrong" instance (RangeClass v1 c1, RangeClass v2 c2) => RangeClass (v1, v2) (c1, c2) where range_ :: Range (v1, v2) (c1, c2) -> LocalReader ReplaceRule range_ (Range (v1 v1, v2 v2) (c1 c1, c2 c2)) = do ([String] gs1, [[[Generator]]] gwss1) <- Range v1 c1 -> LocalReader ReplaceRule forall v c. RangeClass v c => Range v c -> LocalReader ReplaceRule range_ (v1 -> c1 -> Range v1 c1 forall v c. v -> c -> Range v c Range v1 v1 c1 c1) ([String] gs2, [[[Generator]]] gwss2) <- Range v2 c2 -> LocalReader ReplaceRule forall v c. RangeClass v c => Range v c -> LocalReader ReplaceRule range_ (v2 -> c2 -> Range v2 c2 forall v c. v -> c -> Range v c Range v2 v2 c2 c2) ReplaceRule -> LocalReader ReplaceRule forall (m :: * -> *) a. Monad m => a -> m a return (ReplaceRule -> LocalReader ReplaceRule) -> ReplaceRule -> LocalReader ReplaceRule forall a b. (a -> b) -> a -> b $ ([String] gs1 [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String] gs2, ([[Generator]] -> [[Generator]] -> [[Generator]]) -> [[[Generator]]] -> [[[Generator]]] -> [[[Generator]]] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith [[Generator]] -> [[Generator]] -> [[Generator]] forall a. [a] -> [a] -> [a] (++) [[[Generator]]] gwss1 [[[Generator]]] gwss2) elems_ :: [String] -> [ReplaceAtom] -> LocalReader [(GP.EWord, [ReplaceAtom])] elems_ :: [String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [] [ReplaceAtom] replaceAtoms = [(EWord, [ReplaceAtom])] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] forall (m :: * -> *) a. Monad m => a -> m a return [([], [ReplaceAtom] replaceAtoms)] elems_ allEs :: [String] allEs@(String e:[String] es) [ReplaceAtom] replaceAtoms = do let (String g, GenPow p) = String -> (String, GenPow) elem2gen String e case (ReplaceAtom -> Bool) -> [ReplaceAtom] -> Maybe ReplaceAtom forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (String -> ReplaceAtom -> Bool consistRA String g) [ReplaceAtom] replaceAtoms of Just (String _, [Generator] gw) -> do let ew :: EWord ew = [Generator] -> GenPow -> EWord powGWord [Generator] gw GenPow p EWord -> [(EWord, [ReplaceAtom])] -> [(EWord, [ReplaceAtom])] forall s t a b a. (Each s t a b, Field1 a b [a] [a]) => [a] -> s -> t add EWord ew ([(EWord, [ReplaceAtom])] -> [(EWord, [ReplaceAtom])]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [String] es [ReplaceAtom] replaceAtoms Maybe ReplaceAtom Nothing -> do [ReplaceRule] replaceRules <- ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [ReplaceRule] forall r (m :: * -> *). MonadReader r m => m r R.ask case (ReplaceRule -> Bool) -> [ReplaceRule] -> Maybe ReplaceRule forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (String -> ReplaceRule -> Bool consistRR String g) [ReplaceRule] replaceRules of Maybe ReplaceRule Nothing -> do EWord ew <- (String, GenPow) -> LocalReader EWord elem_ (String g, GenPow p) EWord -> [(EWord, [ReplaceAtom])] -> [(EWord, [ReplaceAtom])] forall s t a b a. (Each s t a b, Field1 a b [a] [a]) => [a] -> s -> t add EWord ew ([(EWord, [ReplaceAtom])] -> [(EWord, [ReplaceAtom])]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [String] es [ReplaceAtom] replaceAtoms Just ([String] gs, [[[Generator]]] gwss) -> ([[(EWord, [ReplaceAtom])]] -> [(EWord, [ReplaceAtom])]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [[(EWord, [ReplaceAtom])]] -> [(EWord, [ReplaceAtom])] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat (ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])]) -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] forall a b. (a -> b) -> a -> b $ ([ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])]) -> [[ReplaceAtom]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ([String] -> [ReplaceAtom] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [(EWord, [ReplaceAtom])] elems_ [String] allEs) ([[ReplaceAtom]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]]) -> [[ReplaceAtom]] -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) [[(EWord, [ReplaceAtom])]] forall a b. (a -> b) -> a -> b $ [ [String] -> [[Generator]] -> [ReplaceAtom] forall a b. [a] -> [b] -> [(a, b)] zip [String] gs [[Generator]] gws [ReplaceAtom] -> [ReplaceAtom] -> [ReplaceAtom] forall a. [a] -> [a] -> [a] ++ [ReplaceAtom] replaceAtoms | [[Generator]] gws <- [[[Generator]]] gwss ] where add :: [a] -> s -> t add [a] ew = (a -> Identity b) -> s -> Identity t forall s t a b. Each s t a b => Traversal s t a b each((a -> Identity b) -> s -> Identity t) -> (([a] -> Identity [a]) -> a -> Identity b) -> ([a] -> Identity [a]) -> s -> Identity t forall b c a. (b -> c) -> (a -> b) -> a -> c .([a] -> Identity [a]) -> a -> Identity b forall s t a b. Field1 s t a b => Lens s t a b _1 (([a] -> Identity [a]) -> s -> Identity t) -> ([a] -> [a]) -> s -> t forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ ([a] ew [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++) data GenPow = JustPow Int | Sharp deriving Int -> GenPow -> String -> String [GenPow] -> String -> String GenPow -> String (Int -> GenPow -> String -> String) -> (GenPow -> String) -> ([GenPow] -> String -> String) -> Show GenPow forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [GenPow] -> String -> String $cshowList :: [GenPow] -> String -> String show :: GenPow -> String $cshow :: GenPow -> String showsPrec :: Int -> GenPow -> String -> String $cshowsPrec :: Int -> GenPow -> String -> String Show elem2gen :: String -> (String, GenPow) elem2gen :: String -> (String, GenPow) elem2gen String s = case (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) span (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= Char '^') String s of (String g, []) -> (String g, Int -> GenPow JustPow Int 1) (String g, String "^#") -> (String g, GenPow Sharp) (String g, Char _:String p) -> (String g, Int -> GenPow JustPow (Int -> GenPow) -> Int -> GenPow forall a b. (a -> b) -> a -> b $ String -> Int forall a. Read a => String -> a read String p) powGWord :: GP.GWord -> GenPow -> GP.EWord powGWord :: [Generator] -> GenPow -> EWord powGWord [Generator] gw (JustPow Int p) | Int p Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 = Int -> EWord -> EWord forall a b. (Semigroup a, Integral b) => b -> a -> a stimes Int p (EWord -> EWord) -> EWord -> EWord forall a b. (a -> b) -> a -> b $ Generator -> Signed Generator forall a. a -> Signed a GP.Positive (Generator -> Signed Generator) -> [Generator] -> EWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Generator] gw | Int p Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 0 = [] | Bool otherwise = Int -> EWord -> EWord forall a b. (Semigroup a, Integral b) => b -> a -> a stimes (-Int p) (EWord -> EWord) -> EWord -> EWord forall a b. (a -> b) -> a -> b $ Generator -> Signed Generator forall a. a -> Signed a GP.Negative (Generator -> Signed Generator) -> [Generator] -> EWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Generator] -> [Generator] forall a. [a] -> [a] reverse [Generator] gw powGWord [Generator] gw GenPow Sharp = Generator -> Signed Generator forall a. a -> Signed a GP.Negative (Generator -> Signed Generator) -> [Generator] -> EWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Generator] gw elem_ :: (String, GenPow) -> LocalReader GP.EWord elem_ :: (String, GenPow) -> LocalReader EWord elem_ (String g, GenPow p) = do Generator g' <- String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ String g EWord -> LocalReader EWord forall (m :: * -> *) a. Monad m => a -> m a return (EWord -> LocalReader EWord) -> EWord -> LocalReader EWord forall a b. (a -> b) -> a -> b $ [Generator] -> GenPow -> EWord powGWord [Generator g'] GenPow p gen_ :: String -> LocalReader GP.Generator gen_ :: String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator gen_ String g = do GeneratorsDescr gsd <- ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) GeneratorsDescr -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) GeneratorsDescr forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe) GeneratorsDescr forall r (m :: * -> *). MonadReader r m => m r R.ask GeneratorsDescr gsd GeneratorsDescr -> String -> ReaderT [ReplaceRule] (ReaderT GeneratorsDescr (ReaderT SemigroupPresentation Maybe)) Generator forall c k v (m :: * -> *). (Indexable c k v, MonadFail m) => c -> k -> m v !? String g