{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}

module TM2SP.Generators (
    Gens,
    simple,
    from,
    gens,
  ) where

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

import qualified Control.Monad.Reader as R
import Control.Monad.Trans (lift)

type Gens = [Gen]

data Gen =
      JustGens String
    | GroupGens String StrGetter

type StrGetter = TM.TMGetter (Set String)

simple :: String -> Gen
simple :: String -> Gen
simple = String -> Gen
JustGens

from :: String -> StrGetter -> Gen
from :: String -> StrGetter -> Gen
from = String -> StrGetter -> Gen
GroupGens

type LocalReader = R.ReaderT TM.TuringMachine Maybe

gens :: MonadFail m => Gens -> TM.TuringMachine -> m SP.GeneratorsDescr
gens :: Gens -> TuringMachine -> m GeneratorsDescr
gens = (m GeneratorsDescr
-> (GeneratorsDescr -> m GeneratorsDescr)
-> Maybe GeneratorsDescr
-> m GeneratorsDescr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m GeneratorsDescr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't create generators") GeneratorsDescr -> m GeneratorsDescr
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GeneratorsDescr -> m GeneratorsDescr)
-> (TuringMachine -> Maybe GeneratorsDescr)
-> TuringMachine
-> m GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((TuringMachine -> Maybe GeneratorsDescr)
 -> TuringMachine -> m GeneratorsDescr)
-> (Gens -> TuringMachine -> Maybe GeneratorsDescr)
-> Gens
-> TuringMachine
-> m GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT TuringMachine Maybe GeneratorsDescr
-> TuringMachine -> Maybe GeneratorsDescr
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (ReaderT TuringMachine Maybe GeneratorsDescr
 -> TuringMachine -> Maybe GeneratorsDescr)
-> (Gens -> ReaderT TuringMachine Maybe GeneratorsDescr)
-> Gens
-> TuringMachine
-> Maybe GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gens -> ReaderT TuringMachine Maybe GeneratorsDescr
gens_

gens_ :: Gens -> LocalReader SP.GeneratorsDescr
gens_ :: Gens -> ReaderT TuringMachine Maybe GeneratorsDescr
gens_ Gens
gs = do
    [String]
genNames <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ReaderT TuringMachine Maybe [[String]]
-> ReaderT TuringMachine Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen -> ReaderT TuringMachine Maybe [String])
-> Gens -> ReaderT TuringMachine Maybe [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Gen -> ReaderT TuringMachine Maybe [String]
gen_ Gens
gs
    [(Generator, String)]
-> ReaderT TuringMachine Maybe GeneratorsDescr
forall c v (m :: * -> *). (Listable c v, MonadFail m) => [v] -> m c
fromList_ ([(Generator, String)]
 -> ReaderT TuringMachine Maybe GeneratorsDescr)
-> [(Generator, String)]
-> ReaderT TuringMachine Maybe GeneratorsDescr
forall a b. (a -> b) -> a -> b
$ [Generator] -> [String] -> [(Generator, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Generator
forall a. Bounded a => a
minBound..] [String]
genNames

gen_ :: Gen -> LocalReader [String]
gen_ :: Gen -> ReaderT TuringMachine Maybe [String]
gen_ (JustGens String
gs) =
    [String] -> ReaderT TuringMachine Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ReaderT TuringMachine Maybe [String])
-> [String] -> ReaderT TuringMachine Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
gs
gen_ (GroupGens String
str StrGetter
strGetter) = do
    [String]
stateNames <- Set String -> [String]
forall c v. Listable c v => c -> [v]
toList (Set String -> [String])
-> ReaderT TuringMachine Maybe (Set String)
-> ReaderT TuringMachine Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set String) TuringMachine (Set String)
-> ReaderT TuringMachine Maybe (Set String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Set String) TuringMachine (Set String)
StrGetter
strGetter
    SimpleFormat
f :: SimpleFormat <- Maybe SimpleFormat -> ReaderT TuringMachine Maybe SimpleFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe SimpleFormat -> ReaderT TuringMachine Maybe SimpleFormat)
-> Maybe SimpleFormat -> ReaderT TuringMachine Maybe SimpleFormat
forall a b. (a -> b) -> a -> b
$ String -> Maybe SimpleFormat
forall f (m :: * -> *). (Format f, MonadFail m) => String -> m f
format String
str
    [String] -> ReaderT TuringMachine Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ReaderT TuringMachine Maybe [String])
-> [String] -> ReaderT TuringMachine Maybe [String]
forall a b. (a -> b) -> a -> b
$ SimpleFormat -> String -> String
forall f i. Apply f i => f -> i -> String
apply SimpleFormat
f (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
stateNames