module GapFuncWriter where

import GRType
import qualified Data.Map.Strict as Map
import System.IO
import qualified Data.Set as Set
import Helpers
import Data.Maybe (fromMaybe)

writeGenerators :: [A] -> Map.Map A String -> Handle -> IO ()
writeGenerators :: [A] -> Map A String -> Handle -> IO ()
writeGenerators [A]
generators Map A String
amap Handle
handle =
    do
        Handle -> String -> IO ()
hPutStr Handle
handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
mdata
        (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ( \String
x -> Handle -> String -> IO ()
hPutStr Handle
handle String
", " IO () -> IO () -> IO ()
forall a. Semigroup a => a -> a -> a
<> Handle -> String -> IO ()
hPutStr Handle
handle String
x) ([String] -> [String]
forall a. [a] -> [a]
tail [String]
mdata)
        where   toStr :: A -> String
toStr A
a = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ A -> String
forall a. Show a => a -> String
show A
a) (A -> Map A String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup A
a Map A String
amap)
                quotes :: String -> String
quotes String
s = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
                mdata :: [String]
mdata = (A -> String) -> [A] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
quotes (String -> String) -> (A -> String) -> A -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. A -> String
toStr) [A]
generators

writeRelations :: [GrRelation] -> Map.Map A String -> Handle -> IO()
writeRelations :: [GrRelation] -> Map A String -> Handle -> IO ()
writeRelations [GrRelation]
relations Map A String
genmap Handle
handle =
    do
        Handle -> String -> IO ()
hPutStr Handle
handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
mdata
        (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ( \String
x -> Handle -> String -> IO ()
hPutStr Handle
handle String
", " IO () -> IO () -> IO ()
forall a. Semigroup a => a -> a -> a
<> Handle -> String -> IO ()
hPutStr Handle
handle String
x) ([String] -> [String]
forall a. [a] -> [a]
tail [String]
mdata)
    where
            mdata :: [String]
mdata = (GrRelation -> String) -> [GrRelation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String) -> [String] -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\String
x String
y -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y) ([String] -> String)
-> (GrRelation -> [String]) -> GrRelation -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SmbR -> String) -> [SmbR] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Map A String -> SmbR -> String
printSmb Map A String
genmap) ([SmbR] -> [String])
-> (GrRelation -> [SmbR]) -> GrRelation -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrRelation -> [SmbR]
revertRel) [GrRelation]
relations

writeGap :: GR -> Handle -> Map.Map A String -> [SmbR] -> IO ()
writeGap :: GR -> Handle -> Map A String -> [SmbR] -> IO ()
writeGap (GR (Set A
g, Set GrRelation
r)) Handle
handle Map A String
genmap [SmbR]
hub =
--            do  hPutStr handle "local f, g, p;\n"
            do  Handle -> String -> IO ()
hPutStr Handle
handle String
"local f, g;\n"
                Handle -> String -> IO ()
hPutStr Handle
handle String
"f := FreeGroup( "
                [A] -> Map A String -> Handle -> IO ()
writeGenerators [A]
generators Map A String
genmap Handle
handle
                Handle -> String -> IO ()
hPutStr Handle
handle String
" );\n"
                Handle -> IO ()
hFlush Handle
handle
                Handle -> String -> IO ()
hPutStr Handle
handle (String
"hub := " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hubstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n")
                Handle -> IO ()
hFlush Handle
handle
                Handle -> String -> IO ()
hPutStr Handle
handle String
"g := f / [ "
                [GrRelation] -> Map A String -> Handle -> IO ()
writeRelations [GrRelation]
relations Map A String
genmap Handle
handle
                Handle -> String -> IO ()
hPutStr Handle
handle String
" ];\n"
                Handle -> IO ()
hFlush Handle
handle
                --hPutStr handle "p := SimplifiedFpGroup( g );\n"
                --hPutStr handle "return p;\n"
                Handle -> String -> IO ()
hPutStr Handle
handle String
"return g;\n"

                    where
                        generators :: [A]
generators = Set A -> [A]
forall a. Set a -> [a]
Set.toList Set A
g
                        relations :: [GrRelation]
relations = Set GrRelation -> [GrRelation]
forall a. Set a -> [a]
Set.toList Set GrRelation
r
                        hubstr :: String
hubstr = (String -> String -> String) -> [String] -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\String
x String
y -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SmbR -> String) -> [SmbR] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Map A String -> SmbR -> String
printSmb Map A String
genmap) [SmbR]
hub

writeWord :: [SmbR] -> Handle -> Map.Map A String -> IO()
writeWord :: [SmbR] -> Handle -> Map A String -> IO ()
writeWord [SmbR]
as Handle
handle Map A String
genmap =
            do  Handle -> String -> IO ()
hPutStr Handle
handle String
mdata
                Handle -> String -> IO ()
hPutStr Handle
handle String
";"
                Handle -> IO ()
hFlush Handle
handle
            where
                mdata :: String
mdata = (String -> String -> String) -> [String] -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\String
x String
y -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SmbR -> String) -> [SmbR] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Map A String -> SmbR -> String
printSmb Map A String
genmap) [SmbR]
as