{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}

module SP2GP.Generators (
    Gens,
    simple,
    from,
    group,
    gens,
  ) 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 Control.Monad.Trans (lift)

type Gens = [Gen]

data Gen =
      JustGens String
    | FromGroupGens String StrGetter
    | JustGroupGens StrGetter

type StrGetter = SP.SPGetting (Set String)

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

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

group :: StrGetter -> Gen
group :: StrGetter -> Gen
group = StrGetter -> Gen
JustGroupGens

type LocalReader = R.ReaderT SP.SemigroupPresentation Maybe

gens :: MonadFail m => Gens -> SP.SemigroupPresentation -> m GP.GeneratorsDescr
gens :: Gens -> SemigroupPresentation -> 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)
-> (SemigroupPresentation -> Maybe GeneratorsDescr)
-> SemigroupPresentation
-> m GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((SemigroupPresentation -> Maybe GeneratorsDescr)
 -> SemigroupPresentation -> m GeneratorsDescr)
-> (Gens -> SemigroupPresentation -> Maybe GeneratorsDescr)
-> Gens
-> SemigroupPresentation
-> m GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SemigroupPresentation Maybe GeneratorsDescr
-> SemigroupPresentation -> Maybe GeneratorsDescr
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (ReaderT SemigroupPresentation Maybe GeneratorsDescr
 -> SemigroupPresentation -> Maybe GeneratorsDescr)
-> (Gens -> ReaderT SemigroupPresentation Maybe GeneratorsDescr)
-> Gens
-> SemigroupPresentation
-> Maybe GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gens -> ReaderT SemigroupPresentation Maybe GeneratorsDescr
gens_

gens_ :: Gens -> LocalReader GP.GeneratorsDescr
gens_ :: Gens -> ReaderT SemigroupPresentation Maybe GeneratorsDescr
gens_ Gens
gs = do
    [String]
genNames <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ReaderT SemigroupPresentation Maybe [[String]]
-> ReaderT SemigroupPresentation Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen -> ReaderT SemigroupPresentation Maybe [String])
-> Gens -> ReaderT SemigroupPresentation Maybe [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Gen -> ReaderT SemigroupPresentation Maybe [String]
gen_ Gens
gs
    [(Generator, String)]
-> ReaderT SemigroupPresentation Maybe GeneratorsDescr
forall c v (m :: * -> *). (Listable c v, MonadFail m) => [v] -> m c
fromList_ ([(Generator, String)]
 -> ReaderT SemigroupPresentation Maybe GeneratorsDescr)
-> [(Generator, String)]
-> ReaderT SemigroupPresentation 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 SemigroupPresentation Maybe [String]
gen_ (JustGens String
gs) =
    [String] -> ReaderT SemigroupPresentation Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ReaderT SemigroupPresentation Maybe [String])
-> [String] -> ReaderT SemigroupPresentation Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
gs
gen_ (FromGroupGens String
str StrGetter
strGetter) = do
    [String]
stateNames <- Set String -> [String]
forall c v. Listable c v => c -> [v]
toList (Set String -> [String])
-> ReaderT SemigroupPresentation Maybe (Set String)
-> ReaderT SemigroupPresentation Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrGetter -> ReaderT SemigroupPresentation Maybe (Set String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view StrGetter
strGetter
    SimpleFormat
f :: SimpleFormat <- Maybe SimpleFormat
-> ReaderT SemigroupPresentation Maybe SimpleFormat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe SimpleFormat
 -> ReaderT SemigroupPresentation Maybe SimpleFormat)
-> Maybe SimpleFormat
-> ReaderT SemigroupPresentation 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 SemigroupPresentation Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ReaderT SemigroupPresentation Maybe [String])
-> [String] -> ReaderT SemigroupPresentation 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
gen_ (JustGroupGens StrGetter
strGetter) = do
    [String]
stateNames <- Set String -> [String]
forall c v. Listable c v => c -> [v]
toList (Set String -> [String])
-> ReaderT SemigroupPresentation Maybe (Set String)
-> ReaderT SemigroupPresentation Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrGetter -> ReaderT SemigroupPresentation Maybe (Set String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view StrGetter
strGetter
    [String] -> ReaderT SemigroupPresentation Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
stateNames