{-# 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