{-# LANGUAGE RankNTypes, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables, ExistentialQuantification, FlexibleContexts, UndecidableInstances, DefaultSignatures #-}

module TM2SP.Relations (
    Rels,
    (===),
    for',
    in',
    rels,
  ) where

import qualified TuringMachine as TM
import qualified SemigroupPresentation as SP
import Containers
import Lens
import Format

import qualified Control.Monad.Reader as R
import qualified Control.Monad.List as LT
import Control.Monad.Trans (lift)
import Control.Monad (when)
import Control.Lens (each)
import Data.Maybe (catMaybes)
import Data.List (find)

type Rels = [Rel]

data Rel =
    JustRel String String
  | forall e. RangeElement e => ForBlock (Range e) Rels

data Range e = Range String (SetGetter e)

type SetGetter a = TM.TMGetter (Set a)

(===) :: String -> String -> Rel
=== :: String -> String -> Rel
(===) = String -> String -> Rel
JustRel

for' :: RangeElement e => Range e -> Rels -> Rel
for' :: Range e -> Rels -> Rel
for' = Range e -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
ForBlock

in' :: RangeElement e => String -> SetGetter e -> Range e
in' :: String -> SetGetter e -> Range e
in' = String -> SetGetter e -> Range e
forall e. String -> SetGetter e -> Range e
Range

type LocalReader a =
    forall m. MonadFail m =>
    R.ReaderT ReplaceRules (
        R.ReaderT SP.GeneratorsDescr (
            R.ReaderT TM.TuringMachine
                m
          )
      )
      a

liftTM :: MonadFail m => R.ReaderT TM.TuringMachine m a -> R.ReaderT ReplaceRules (R.ReaderT SP.GeneratorsDescr (R.ReaderT TM.TuringMachine m)) a
liftTM :: ReaderT TuringMachine m a
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a
liftTM = ReaderT GeneratorsDescr (ReaderT TuringMachine m) a
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT GeneratorsDescr (ReaderT TuringMachine m) a
 -> ReaderT
      ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a)
-> (ReaderT TuringMachine m a
    -> ReaderT GeneratorsDescr (ReaderT TuringMachine m) a)
-> ReaderT TuringMachine m a
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT TuringMachine m a
-> ReaderT GeneratorsDescr (ReaderT TuringMachine m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

type ReplaceRules = [ReplaceRule]

type ReplaceRule = ([String], [[SP.Generator]])

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, SP.Generator)

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 ->
    SP.GeneratorsDescr ->
    TM.TuringMachine ->
    m SP.Relations
rels :: Rels -> GeneratorsDescr -> TuringMachine -> m Relations
rels =
    (ReaderT TuringMachine m Relations -> TuringMachine -> m Relations
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (ReaderT TuringMachine m Relations -> TuringMachine -> m Relations)
-> (GeneratorsDescr -> ReaderT TuringMachine m Relations)
-> GeneratorsDescr
-> TuringMachine
-> m Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((GeneratorsDescr -> ReaderT TuringMachine m Relations)
 -> GeneratorsDescr -> TuringMachine -> m Relations)
-> (Rels -> GeneratorsDescr -> ReaderT TuringMachine m Relations)
-> Rels
-> GeneratorsDescr
-> TuringMachine
-> m Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations
-> GeneratorsDescr -> ReaderT TuringMachine m Relations
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations
 -> GeneratorsDescr -> ReaderT TuringMachine m Relations)
-> (Rels
    -> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations)
-> Rels
-> GeneratorsDescr
-> ReaderT TuringMachine m Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   Relations
 -> ReplaceRules
 -> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations)
-> ReplaceRules
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Relations
-> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  ReplaceRules
  (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
  Relations
-> ReplaceRules
-> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT [] (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   Relations
 -> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations)
-> (Rels
    -> ReaderT
         ReplaceRules
         (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
         Relations)
-> Rels
-> ReaderT GeneratorsDescr (ReaderT TuringMachine m) Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Rels
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Relations
Rels -> LocalReader Relations
rels_

rels_ :: Rels -> LocalReader SP.Relations
rels_ :: Rels -> LocalReader 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
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[Relation]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Relations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rel
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [Relation])
-> Rels
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[Relation]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Rel
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
Rel -> LocalReader [Relation]
rel_ Rels
rs

rel_ :: Rel -> LocalReader [SP.Relation]
rel_ :: Rel -> LocalReader [Relation]
rel_ (JustRel String
gw1 String
gw2) = ListT
  (ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
  Relation
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
forall (m :: * -> *) a. ListT m a -> m [a]
LT.runListT (ListT
   (ReaderT
      ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
   Relation
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [Relation])
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     Relation
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
forall a b. (a -> b) -> a -> b
$ do
    let gs1 :: [String]
gs1 = String -> [String]
words String
gw1
        gs2 :: [String]
gs2 = String -> [String]
words String
gw2
    (GWord
gws1, [ReplaceAtom]
srrs) <- ReaderT
  ReplaceRules
  (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
  [(GWord, [ReplaceAtom])]
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     (GWord, [ReplaceAtom])
forall (m :: * -> *) a. m [a] -> ListT m a
LT.ListT (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   [(GWord, [ReplaceAtom])]
 -> ListT
      (ReaderT
         ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
      (GWord, [ReplaceAtom]))
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     (GWord, [ReplaceAtom])
forall a b. (a -> b) -> a -> b
$ [String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [String]
gs1 []
    (GWord
gws2, [ReplaceAtom]
_)    <- ReaderT
  ReplaceRules
  (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
  [(GWord, [ReplaceAtom])]
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     (GWord, [ReplaceAtom])
forall (m :: * -> *) a. m [a] -> ListT m a
LT.ListT (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   [(GWord, [ReplaceAtom])]
 -> ListT
      (ReaderT
         ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
      (GWord, [ReplaceAtom]))
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     (GWord, [ReplaceAtom])
forall a b. (a -> b) -> a -> b
$ [String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [String]
gs2 [ReplaceAtom]
srrs
    Relation
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     Relation
forall (m :: * -> *) a. Monad m => a -> m a
return (Relation
 -> ListT
      (ReaderT
         ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
      Relation)
-> Relation
-> ListT
     (ReaderT
        ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)))
     Relation
forall a b. (a -> b) -> a -> b
$ GWord -> GWord -> Relation
SP.relation GWord
gws1 GWord
gws2
rel_ (ForBlock Range e
rg Rels
rs) = do
    ReplaceRule
newRule <- Range e -> LocalReader ReplaceRule
forall e. RangeElement e => Range e -> LocalReader ReplaceRule
range_ Range e
rg
    (ReplaceRules -> ReplaceRules)
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local (ReplaceRule
newRuleReplaceRule -> ReplaceRules -> ReplaceRules
forall a. a -> [a] -> [a]
:) (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   [Relation]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [Relation])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
forall a b. (a -> b) -> a -> b
$ Relations -> [Relation]
forall c v. Listable c v => c -> [v]
toList (Relations -> [Relation])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Relations
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [Relation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rels -> LocalReader Relations
rels_ Rels
rs

class RangeElement e where
    dimension :: Set e -> Int
    range_ :: Range e -> LocalReader ReplaceRule
    default range_ ::
        (Sizable e, Listable e String, Ord e) =>
        Range e -> LocalReader ReplaceRule
    range_ (Range String
str SetGetter e
cStrGetter) = do
        Set e
cStrSet <- ReaderT TuringMachine m (Set e)
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     (Set e)
forall (m :: * -> *) a.
MonadFail m =>
ReaderT TuringMachine m a
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a
liftTM (ReaderT TuringMachine m (Set e)
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      (Set e))
-> ReaderT TuringMachine m (Set e)
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     (Set e)
forall a b. (a -> b) -> a -> b
$ Getting (Set e) TuringMachine (Set e)
-> ReaderT TuringMachine m (Set e)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set e) TuringMachine (Set e)
SetGetter e
cStrGetter
        let fs' :: [String]
fs' = String -> [String]
words String
str
        Bool
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Set e -> Int
forall e. RangeElement e => Set e -> Int
dimension Set e
cStrSet) (ReaderT
   ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      ())
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall a b. (a -> b) -> a -> b
$
            String
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                String
"Amount of formats does not equal to dimension of received data"
        let [Maybe TaggedFormat]
mfs :: [Maybe TaggedFormat] = String -> Maybe TaggedFormat
forall f (m :: * -> *). (Format f, MonadFail m) => String -> m f
format (String -> Maybe TaggedFormat) -> [String] -> [Maybe TaggedFormat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
fs'
        let strsList :: [[String]]
strsList = e -> [String]
forall c v. Listable c v => c -> [v]
toList (e -> [String]) -> [e] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set e -> [e]
forall c v. Listable c v => c -> [v]
toList Set e
cStrSet
            gs' :: [[String]]
gs' = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String])
-> ([String] -> [Maybe String]) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe TaggedFormat -> String -> Maybe String)
-> [Maybe TaggedFormat] -> [String] -> [Maybe String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((TaggedFormat -> String -> String)
-> Maybe TaggedFormat -> String -> Maybe String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TaggedFormat -> String -> String
forall f i. Apply f i => f -> i -> String
apply) [Maybe TaggedFormat]
mfs ([String] -> [String]) -> [[String]] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]]
strsList
        [GWord]
gs <- (([String]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      GWord)
-> [[String]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [GWord]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(([String]
  -> ReaderT
       ReplaceRules
       (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
       GWord)
 -> [[String]]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [GWord])
-> ((String
     -> ReaderT
          ReplaceRules
          (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
          Generator)
    -> [String]
    -> ReaderT
         ReplaceRules
         (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
         GWord)
-> (String
    -> ReaderT
         ReplaceRules
         (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
         Generator)
-> [[String]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [GWord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      Generator)
-> [String]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     GWord
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) String
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Generator
String -> LocalReader Generator
gen_ [[String]]
gs'
        ReplaceRule
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     ReplaceRule
forall (m :: * -> *) a. Monad m => a -> m a
return (TaggedFormat -> String
forall f. Apply f () => f -> String
format2str (TaggedFormat -> String) -> [TaggedFormat] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe TaggedFormat] -> [TaggedFormat]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TaggedFormat]
mfs, [GWord]
gs)

instance RangeElement String where
    dimension :: Set String -> Int
dimension = Int -> Set String -> Int
forall a b. a -> b -> a
const Int
1
    range_ :: Range String -> LocalReader ReplaceRule
range_ (Range String
str SetGetter String
strGetter) = do
        let fs' :: [String]
fs' = String -> [String]
words String
str
        Bool
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([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) (ReaderT
   ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      ())
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall a b. (a -> b) -> a -> b
$
            String
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                String
"Amount of formats does not equal to dimension of received data"
        let f' :: String
f' = [String] -> String
forall a. [a] -> a
head [String]
fs'
        TaggedFormat
f :: TaggedFormat <- String
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     TaggedFormat
forall f (m :: * -> *). (Format f, MonadFail m) => String -> m f
format String
f'
        Set String
strSet <- ReaderT TuringMachine m (Set String)
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     (Set String)
forall (m :: * -> *) a.
MonadFail m =>
ReaderT TuringMachine m a
-> ReaderT
     ReplaceRules (ReaderT GeneratorsDescr (ReaderT TuringMachine m)) a
liftTM (ReaderT TuringMachine m (Set String)
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      (Set String))
-> ReaderT TuringMachine m (Set String)
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     (Set String)
forall a b. (a -> b) -> a -> b
$ Getting (Set String) TuringMachine (Set String)
-> ReaderT TuringMachine m (Set String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set String) TuringMachine (Set String)
SetGetter String
strGetter
        let strList :: [String]
strList = Set String -> [String]
forall c v. Listable c v => c -> [v]
toList Set String
strSet
        GWord
gs <- (String
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      Generator)
-> [String]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     GWord
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Generator
String -> LocalReader Generator
gen_ ([String]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      GWord)
-> [String]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     GWord
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
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     ReplaceRule
forall (m :: * -> *) a. Monad m => a -> m a
return ([TaggedFormat -> String
forall f. Apply f () => f -> String
format2str TaggedFormat
f], Generator -> GWord
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Generator -> GWord) -> GWord -> [GWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GWord
gs)

instance RangeElement (Quadruple String) where
    dimension :: Set (Quadruple String) -> Int
dimension = Int -> Set (Quadruple String) -> Int
forall a b. a -> b -> a
const Int
4

instance RangeElement [String] where
    dimension :: Set [String] -> Int
dimension = ([String] -> Int -> Int) -> Int -> Set [String] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int) -> ([String] -> Int) -> [String] -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Int
42

gens_ ::
    [String] ->
    [ReplaceAtom] ->
    LocalReader [(SP.GWord, [ReplaceAtom])]
gens_ :: [String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [] [ReplaceAtom]
replaceAtoms = [(GWord, [ReplaceAtom])]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
forall (m :: * -> *) a. Monad m => a -> m a
return [([], [ReplaceAtom]
replaceAtoms)]
gens_ allGs :: [String]
allGs@(String
g:[String]
gs) [ReplaceAtom]
replaceAtoms =
    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
gen) ->
            Generator -> [(GWord, [ReplaceAtom])] -> [(GWord, [ReplaceAtom])]
forall s t a b a. (Each s t a b, Field1 a b [a] [a]) => a -> s -> t
add Generator
gen ([(GWord, [ReplaceAtom])] -> [(GWord, [ReplaceAtom])])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [String]
gs [ReplaceAtom]
replaceAtoms
        Maybe ReplaceAtom
Nothing -> do
            ReplaceRules
replaceRules <- ReaderT
  ReplaceRules
  (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
  ReplaceRules
forall r (m :: * -> *). MonadReader r m => m r
R.ask
            case (ReplaceRule -> Bool) -> ReplaceRules -> Maybe ReplaceRule
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> ReplaceRule -> Bool
consistRR String
g) ReplaceRules
replaceRules of
                Maybe ReplaceRule
Nothing -> do
                    Generator
gen <- String -> LocalReader Generator
gen_ String
g
                    Generator -> [(GWord, [ReplaceAtom])] -> [(GWord, [ReplaceAtom])]
forall s t a b a. (Each s t a b, Field1 a b [a] [a]) => a -> s -> t
add Generator
gen ([(GWord, [ReplaceAtom])] -> [(GWord, [ReplaceAtom])])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [String]
gs [ReplaceAtom]
replaceAtoms
                Just ([String]
gs', [GWord]
genss) ->
                    ([[(GWord, [ReplaceAtom])]] -> [(GWord, [ReplaceAtom])])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[(GWord, [ReplaceAtom])]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(GWord, [ReplaceAtom])]] -> [(GWord, [ReplaceAtom])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT
   ReplaceRules
   (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
   [[(GWord, [ReplaceAtom])]]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [(GWord, [ReplaceAtom])])
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[(GWord, [ReplaceAtom])]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [(GWord, [ReplaceAtom])]
forall a b. (a -> b) -> a -> b
$
                        ([ReplaceAtom]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [(GWord, [ReplaceAtom])])
-> [[ReplaceAtom]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[(GWord, [ReplaceAtom])]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([String] -> [ReplaceAtom] -> LocalReader [(GWord, [ReplaceAtom])]
gens_ [String]
allGs) ([[ReplaceAtom]]
 -> ReaderT
      ReplaceRules
      (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
      [[(GWord, [ReplaceAtom])]])
-> [[ReplaceAtom]]
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     [[(GWord, [ReplaceAtom])]]
forall a b. (a -> b) -> a -> b
$
                            [ [String] -> GWord -> [ReplaceAtom]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
gs' GWord
gens [ReplaceAtom] -> [ReplaceAtom] -> [ReplaceAtom]
forall a. [a] -> [a] -> [a]
++ [ReplaceAtom]
replaceAtoms
                            | GWord
gens <- [GWord]
genss
                            ]
      where
        add :: a -> s -> t
add a
gen = (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
gen a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

gen_ :: String -> LocalReader SP.Generator
gen_ :: String -> LocalReader Generator
gen_ String
g = do
    GeneratorsDescr
gsd <- ReaderT GeneratorsDescr (ReaderT TuringMachine m) GeneratorsDescr
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     GeneratorsDescr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT GeneratorsDescr (ReaderT TuringMachine m) GeneratorsDescr
forall r (m :: * -> *). MonadReader r m => m r
R.ask
    GeneratorsDescr
gsd GeneratorsDescr
-> String
-> ReaderT
     ReplaceRules
     (ReaderT GeneratorsDescr (ReaderT TuringMachine m))
     Generator
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? String
g