{-# LANGUAGE TemplateHaskell, TupleSections, RankNTypes #-}

-- |Module `SemigroupPresentation` include type of semigroup presentation and
--  useful objects for working with it. This module also export other useful
--  modules.
module SemigroupPresentation (
    GeneratorsDescr,
    SemigroupPresentation,
    semigroupPresentation,
    relations,
    generatorsDescr,
    SPGetter,
    SPGetting,
    SPTraversal',
    generators,
    allGenerators,
    strRelations,
    strGenerators,
    strNumRelations,
    asStrSet,
    module SemigroupPresentation.Relation,
    module Containers,
    module Lens,
  ) where

import SemigroupPresentation.Relation
import Containers
import Lens

import Control.Applicative (liftA2)
import Data.Maybe (fromMaybe, mapMaybe)

type GeneratorsDescr = IsoMap Generator String

data SemigroupPresentation = SP
  { SemigroupPresentation -> Relations
_relations :: Relations
  , SemigroupPresentation -> GeneratorsDescr
_generatorsDescr :: GeneratorsDescr
  }

semigroupPresentation :: Relations -> GeneratorsDescr -> SemigroupPresentation
semigroupPresentation :: Relations -> GeneratorsDescr -> SemigroupPresentation
semigroupPresentation = Relations -> GeneratorsDescr -> SemigroupPresentation
SP

makeLenses ''SemigroupPresentation

instance Show SemigroupPresentation where
    show :: SemigroupPresentation -> String
show SemigroupPresentation
sp =
        ((Pair [Generator] -> String) -> [Pair [Generator]] -> String)
-> [Pair [Generator]] -> (Pair [Generator] -> String) -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Pair [Generator] -> String) -> [Pair [Generator]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SemigroupPresentation
spSemigroupPresentation
-> Getting
     [Pair [Generator]] SemigroupPresentation [Pair [Generator]]
-> [Pair [Generator]]
forall s a. s -> Getting a s a -> a
^.(Relations -> Const [Pair [Generator]] Relations)
-> SemigroupPresentation
-> Const [Pair [Generator]] SemigroupPresentation
Lens' SemigroupPresentation Relations
relations((Relations -> Const [Pair [Generator]] Relations)
 -> SemigroupPresentation
 -> Const [Pair [Generator]] SemigroupPresentation)
-> (([Pair [Generator]]
     -> Const [Pair [Generator]] [Pair [Generator]])
    -> Relations -> Const [Pair [Generator]] Relations)
-> Getting
     [Pair [Generator]] SemigroupPresentation [Pair [Generator]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Relations -> [Pair [Generator]])
-> ([Pair [Generator]]
    -> Const [Pair [Generator]] [Pair [Generator]])
-> Relations
-> Const [Pair [Generator]] Relations
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Relations -> [Pair [Generator]]
forall c v. Listable c v => c -> [v]
toList) ((Pair [Generator] -> String) -> String)
-> (Pair [Generator] -> String) -> String
forall a b. (a -> b) -> a -> b
$
            \(Pair ([Generator]
gw1, [Generator]
gw2)) ->
                let showGen :: Generator -> String
showGen Generator
g = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"???" (SemigroupPresentation
spSemigroupPresentation
-> Getting (Maybe String) SemigroupPresentation (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^.(GeneratorsDescr -> Const (Maybe String) GeneratorsDescr)
-> SemigroupPresentation
-> Const (Maybe String) SemigroupPresentation
Lens' SemigroupPresentation GeneratorsDescr
generatorsDescr((GeneratorsDescr -> Const (Maybe String) GeneratorsDescr)
 -> SemigroupPresentation
 -> Const (Maybe String) SemigroupPresentation)
-> Generator
-> Getting (Maybe String) SemigroupPresentation (Maybe String)
forall c k v (m :: * -> *) x y.
(Indexable c k v, MonadFail m) =>
Getting x y c -> k -> Getting x y (m v)
.@Generator
g)
                in
                    [String] -> String
unwords ((Generator -> String) -> [Generator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Generator -> String
showGen [Generator]
gw1) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    [String] -> String
unwords ((Generator -> String) -> [Generator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Generator -> String
showGen [Generator]
gw2) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
"\n"

type SPGetter a = Getter SemigroupPresentation a

type SPGetting a = Getting a SemigroupPresentation a

type SPTraversal' a = Traversal' SemigroupPresentation a

generators :: SPTraversal' Generator
generators :: (Generator -> f Generator)
-> SemigroupPresentation -> f SemigroupPresentation
generators Generator -> f Generator
f SemigroupPresentation
sp =
    (Relations -> GeneratorsDescr -> SemigroupPresentation)
-> f Relations -> f GeneratorsDescr -> f SemigroupPresentation
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Relations -> GeneratorsDescr -> SemigroupPresentation
semigroupPresentation
        (SemigroupPresentation
spSemigroupPresentation
-> Getting Relations SemigroupPresentation Relations -> Relations
forall s a. s -> Getting a s a -> a
^.Getting Relations SemigroupPresentation Relations
Lens' SemigroupPresentation Relations
relations       Relations -> (Relations -> f Relations) -> f Relations
forall a b. a -> (a -> b) -> b
& ([Pair [Generator]] -> Relations)
-> f [Pair [Generator]] -> f Relations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pair [Generator]] -> Relations
forall c v. UnsafeListable c v => [v] -> c
fromList (f [Pair [Generator]] -> f Relations)
-> (Relations -> f [Pair [Generator]]) -> Relations -> f Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair [Generator] -> f (Pair [Generator]))
-> [Pair [Generator]] -> f [Pair [Generator]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pair [Generator] -> f (Pair [Generator])
updR  ([Pair [Generator]] -> f [Pair [Generator]])
-> (Relations -> [Pair [Generator]])
-> Relations
-> f [Pair [Generator]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relations -> [Pair [Generator]]
forall c v. Listable c v => c -> [v]
toList)
        (SemigroupPresentation
spSemigroupPresentation
-> Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
-> GeneratorsDescr
forall s a. s -> Getting a s a -> a
^.Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
Lens' SemigroupPresentation GeneratorsDescr
generatorsDescr GeneratorsDescr
-> (GeneratorsDescr -> f GeneratorsDescr) -> f GeneratorsDescr
forall a b. a -> (a -> b) -> b
& ([(Generator, String)] -> GeneratorsDescr)
-> f [(Generator, String)] -> f GeneratorsDescr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Generator, String)] -> GeneratorsDescr
forall c v. UnsafeListable c v => [v] -> c
fromList (f [(Generator, String)] -> f GeneratorsDescr)
-> (GeneratorsDescr -> f [(Generator, String)])
-> GeneratorsDescr
-> f GeneratorsDescr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Generator, String) -> f (Generator, String))
-> [(Generator, String)] -> f [(Generator, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Generator, String) -> f (Generator, String)
forall t. (Generator, t) -> f (Generator, t)
updGD ([(Generator, String)] -> f [(Generator, String)])
-> (GeneratorsDescr -> [(Generator, String)])
-> GeneratorsDescr
-> f [(Generator, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneratorsDescr -> [(Generator, String)]
forall c v. Listable c v => c -> [v]
toList)
          where
            updR :: Pair [Generator] -> f (Pair [Generator])
updR = (([Generator] -> f [Generator])
-> Pair [Generator] -> f (Pair [Generator])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(([Generator] -> f [Generator])
 -> Pair [Generator] -> f (Pair [Generator]))
-> ((Generator -> f Generator) -> [Generator] -> f [Generator])
-> (Generator -> f Generator)
-> Pair [Generator]
-> f (Pair [Generator])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Generator -> f Generator) -> [Generator] -> f [Generator]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Generator -> f Generator
f
            updGD :: (Generator, t) -> f (Generator, t)
updGD (Generator
gen, t
str) = (,t
str) (Generator -> (Generator, t)) -> f Generator -> f (Generator, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Generator -> f Generator
f Generator
gen

allGenerators :: SPGetter (Set Generator)
allGenerators :: (Set Generator -> f (Set Generator))
-> SemigroupPresentation -> f SemigroupPresentation
allGenerators = (SemigroupPresentation -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> SemigroupPresentation
-> f SemigroupPresentation
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((SemigroupPresentation -> Set Generator)
 -> (Set Generator -> f (Set Generator))
 -> SemigroupPresentation
 -> f SemigroupPresentation)
-> (SemigroupPresentation -> Set Generator)
-> (Set Generator -> f (Set Generator))
-> SemigroupPresentation
-> f SemigroupPresentation
forall a b. (a -> b) -> a -> b
$ do
    Relations
rs <- Getting Relations SemigroupPresentation Relations
-> SemigroupPresentation -> Relations
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Relations SemigroupPresentation Relations
Lens' SemigroupPresentation Relations
relations
    GeneratorsDescr
gd <- Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
-> SemigroupPresentation -> GeneratorsDescr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
Lens' SemigroupPresentation GeneratorsDescr
generatorsDescr
    let generatorsFromGD :: Set Generator
generatorsFromGD = GeneratorsDescr -> Set Generator
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet GeneratorsDescr
gd
        generatorsFromR :: Pair [Generator] -> Set Generator
generatorsFromR = [Generator] -> Set Generator
forall c v. UnsafeListable c v => [v] -> c
fromList ([Generator] -> Set Generator)
-> (Pair [Generator] -> [Generator])
-> Pair [Generator]
-> Set Generator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Generator] ([Generator], [Generator]) [Generator]
-> ([Generator], [Generator]) -> [Generator]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Generator] ([Generator], [Generator]) [Generator]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (([Generator], [Generator]) -> [Generator])
-> (Pair [Generator] -> ([Generator], [Generator]))
-> Pair [Generator]
-> [Generator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair [Generator] -> ([Generator], [Generator])
forall a. Pair a -> (a, a)
unPair
    Set Generator -> SemigroupPresentation -> Set Generator
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Generator -> SemigroupPresentation -> Set Generator)
-> Set Generator -> SemigroupPresentation -> Set Generator
forall a b. (a -> b) -> a -> b
$ (Set Generator -> Set Generator -> Set Generator)
-> Set Generator -> [Set Generator] -> Set Generator
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set Generator -> Set Generator -> Set Generator
forall c. Operable c => c -> c -> c
(\/) Set Generator
generatorsFromGD ([Set Generator] -> Set Generator)
-> [Set Generator] -> Set Generator
forall a b. (a -> b) -> a -> b
$ Pair [Generator] -> Set Generator
generatorsFromR (Pair [Generator] -> Set Generator)
-> [Pair [Generator]] -> [Set Generator]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relations -> [Pair [Generator]]
forall c v. Listable c v => c -> [v]
toList Relations
rs

strRelations :: SPGetting (Set StrRelation)
strRelations :: SPGetting (Set StrRelation)
strRelations = (SemigroupPresentation -> Set StrRelation)
-> SPGetting (Set StrRelation)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((SemigroupPresentation -> Set StrRelation)
 -> SPGetting (Set StrRelation))
-> (SemigroupPresentation -> Set StrRelation)
-> SPGetting (Set StrRelation)
forall a b. (a -> b) -> a -> b
$ do
    GeneratorsDescr
gd <- Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
-> SemigroupPresentation -> GeneratorsDescr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting GeneratorsDescr SemigroupPresentation GeneratorsDescr
Lens' SemigroupPresentation GeneratorsDescr
generatorsDescr
    Relations
rs <- Getting Relations SemigroupPresentation Relations
-> SemigroupPresentation -> Relations
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Relations SemigroupPresentation Relations
Lens' SemigroupPresentation Relations
relations
    Set StrRelation -> SemigroupPresentation -> Set StrRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (Set StrRelation -> SemigroupPresentation -> Set StrRelation)
-> Set StrRelation -> SemigroupPresentation -> Set StrRelation
forall a b. (a -> b) -> a -> b
$ ((Pair [Generator] -> StrRelation) -> Relations -> Set StrRelation
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap((Pair [Generator] -> StrRelation) -> Relations -> Set StrRelation)
-> ((Generator -> Maybe String) -> Pair [Generator] -> StrRelation)
-> (Generator -> Maybe String)
-> Relations
-> Set StrRelation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Generator] -> [String]) -> Pair [Generator] -> StrRelation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([Generator] -> [String]) -> Pair [Generator] -> StrRelation)
-> ((Generator -> Maybe String) -> [Generator] -> [String])
-> (Generator -> Maybe String)
-> Pair [Generator]
-> StrRelation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Generator -> Maybe String) -> [Generator] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe) (GeneratorsDescr
gd GeneratorsDescr -> Generator -> Maybe String
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?) Relations
rs

strGenerators :: SPGetting (Set String)
strGenerators :: SPGetting (Set String)
strGenerators = (GeneratorsDescr -> Const (Set String) GeneratorsDescr)
-> SemigroupPresentation
-> Const (Set String) SemigroupPresentation
Lens' SemigroupPresentation GeneratorsDescr
generatorsDescr ((GeneratorsDescr -> Const (Set String) GeneratorsDescr)
 -> SemigroupPresentation
 -> Const (Set String) SemigroupPresentation)
-> ((Set String -> Const (Set String) (Set String))
    -> GeneratorsDescr -> Const (Set String) GeneratorsDescr)
-> SPGetting (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneratorsDescr -> Set String)
-> (Set String -> Const (Set String) (Set String))
-> GeneratorsDescr
-> Const (Set String) GeneratorsDescr
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GeneratorsDescr -> Set String
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet

strNumRelations :: SPGetting (Set String)
strNumRelations :: SPGetting (Set String)
strNumRelations = (Relations -> Const (Set String) Relations)
-> SemigroupPresentation
-> Const (Set String) SemigroupPresentation
Lens' SemigroupPresentation Relations
relations ((Relations -> Const (Set String) Relations)
 -> SemigroupPresentation
 -> Const (Set String) SemigroupPresentation)
-> ((Set String -> Const (Set String) (Set String))
    -> Relations -> Const (Set String) Relations)
-> SPGetting (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Set String)
-> (Set String -> Const (Set String) (Set String))
-> Relations
-> Const (Set String) Relations
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Relations
rs -> [String] -> Set String
forall c v. UnsafeListable c v => [v] -> c
fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Relations -> Int
forall c. Sizable c => c -> Int
size Relations
rs])

asStrSet :: Show a => Getter a (Set String)
asStrSet :: Getter a (Set String)
asStrSet = (a -> Set String) -> Optic' (->) f a (Set String)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (String -> Set String
forall c v. Singletonable c v => v -> c
singleton (String -> Set String) -> (a -> String) -> a -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)