module MapleFuncWriter 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) mdata :: [String] mdata = (A -> String) -> [A] -> [String] forall a b. (a -> b) -> [a] -> [b] map 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 writeMaple :: GR -> Handle -> Map.Map A String -> IO () writeMaple :: GR -> Handle -> Map A String -> IO () writeMaple (GR (Set A g, Set GrRelation r)) Handle handle Map A String genmap = do Handle -> String -> IO () hPutStr Handle handle String "with( GroupTheory ):\n" Handle -> String -> IO () hPutStr Handle handle String "G := < " [A] -> Map A String -> Handle -> IO () writeGenerators [A] generators Map A String genmap Handle handle Handle -> String -> IO () hPutStr Handle handle String " | " Handle -> IO () hFlush Handle handle [GrRelation] -> Map A String -> Handle -> IO () writeRelations [GrRelation] relations Map A String genmap Handle handle Handle -> String -> IO () hPutStr Handle handle String " = 1 >;\n" Handle -> IO () hFlush Handle handle 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