{-|
Module      : SDParser
Description : Defines a parser which parses text into commands for the program
Copyright   : Anthony Wang, 2021
License     : MIT
Maintainer  : anthony.y.wang.math@gmail.com

@SDParser@ defines a parser which parses text into a list of 'SDCommand's,
which are then handled by the main thread of the program.

The notation for the text parsed is documented in the user's manual for the
@tikzsd@ program.
-}
module SDParser (
    SDCommand (..),
    SDDrawLine (..),
    CompElement (..),
    sd_parser
) where

import Data.Char (isSpace)
import Text.ParserCombinators.Parsec ((<|>), 
                                      GenParser, 
                                      try, 
                                      spaces, 
                                      endBy, 
                                      many, 
                                      char, 
                                      string, 
                                      sepBy,
                                      sepEndBy,
                                      oneOf,
                                      satisfy,
                                      between,
                                      noneOf,
                                      alphaNum)

-- | A 'SDCommand' describes a command parsed from the file.
--
-- We have the following commands:
--
-- - 'DefineCat' is the command for defining a category.
-- 
-- - 'DefineFunc' is the command for defining a basic functor.
--
-- - 'DefineNat' is the command for defining a basic natural transformation.
--
-- - 'DrawNat' is the command for creating a file with the TikZ code for the
-- drawing a string diagram of a natural transformation.
data SDCommand = DefineCat
               { SDCommand -> String
dcat_id :: !String
               , SDCommand -> String
dcat_display_string :: !String
               } |
               DefineFunc
               { SDCommand -> String
dfun_id :: !String
               , SDCommand -> String
dfun_display_string :: !String
               , SDCommand -> String
dfun_source :: !String
               , SDCommand -> String
dfun_target :: !String
               , SDCommand -> String
dfun_opts :: !String
               } |
               DefineNat
               { SDCommand -> String
dnat_id :: !String
               , SDCommand -> String
dnat_display_string :: !String
               , SDCommand -> [CompElement]
dnat_source :: ![CompElement]
               , SDCommand -> [CompElement]
dnat_target :: ![CompElement]
               , SDCommand -> String
dnat_opts :: !String
               , SDCommand -> String
dnat_shape :: !String
               } |
               DrawNat 
               { SDCommand -> String
dn_file_name :: !String
               , SDCommand -> String
dn_opts :: !String
               , SDCommand -> [SDDrawLine]
dn_parts :: ![SDDrawLine]
               }
    deriving Int -> SDCommand -> ShowS
[SDCommand] -> ShowS
SDCommand -> String
(Int -> SDCommand -> ShowS)
-> (SDCommand -> String)
-> ([SDCommand] -> ShowS)
-> Show SDCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDCommand] -> ShowS
$cshowList :: [SDCommand] -> ShowS
show :: SDCommand -> String
$cshow :: SDCommand -> String
showsPrec :: Int -> SDCommand -> ShowS
$cshowsPrec :: Int -> SDCommand -> ShowS
Show
data StructureType = Cat | Func | Nat
    deriving Int -> StructureType -> ShowS
[StructureType] -> ShowS
StructureType -> String
(Int -> StructureType -> ShowS)
-> (StructureType -> String)
-> ([StructureType] -> ShowS)
-> Show StructureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructureType] -> ShowS
$cshowList :: [StructureType] -> ShowS
show :: StructureType -> String
$cshow :: StructureType -> String
showsPrec :: Int -> StructureType -> ShowS
$cshowsPrec :: Int -> StructureType -> ShowS
Show

-- | 'SDDrawLine' describes a line in a 'DrawNat' command.
-- These lines are used to specify a 'NaturalTransformation' and a 'NatFormatting'
-- used format the 'NaturalTransformation'.
-- See the user's manual for notation.
--
-- - 'SDDrawFun' specifies a line used to specify a 'Functor'
-- 
-- - 'SDDrawNat' specifies a line used to specify a horizontal composition of basic natural
-- transformations.
data SDDrawLine = SDDrawFun [CompElement] | SDDrawNat [CompElement]
    deriving Int -> SDDrawLine -> ShowS
[SDDrawLine] -> ShowS
SDDrawLine -> String
(Int -> SDDrawLine -> ShowS)
-> (SDDrawLine -> String)
-> ([SDDrawLine] -> ShowS)
-> Show SDDrawLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDDrawLine] -> ShowS
$cshowList :: [SDDrawLine] -> ShowS
show :: SDDrawLine -> String
$cshow :: SDDrawLine -> String
showsPrec :: Int -> SDDrawLine -> ShowS
$cshowsPrec :: Int -> SDDrawLine -> ShowS
Show
-- | @(CompElement i opts)@ refers to the element with id @i@, modified with options @opts@
data CompElement = Empty |
    CompElement 
    { CompElement -> String
ce_id :: !String
    , CompElement -> String
ce_opts :: !String
    } deriving (Int -> CompElement -> ShowS
[CompElement] -> ShowS
CompElement -> String
(Int -> CompElement -> ShowS)
-> (CompElement -> String)
-> ([CompElement] -> ShowS)
-> Show CompElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompElement] -> ShowS
$cshowList :: [CompElement] -> ShowS
show :: CompElement -> String
$cshow :: CompElement -> String
showsPrec :: Int -> CompElement -> ShowS
$cshowsPrec :: Int -> CompElement -> ShowS
Show, CompElement -> CompElement -> Bool
(CompElement -> CompElement -> Bool)
-> (CompElement -> CompElement -> Bool) -> Eq CompElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompElement -> CompElement -> Bool
$c/= :: CompElement -> CompElement -> Bool
== :: CompElement -> CompElement -> Bool
$c== :: CompElement -> CompElement -> Bool
Eq)

def_or_draw :: GenParser Char st String
def_or_draw :: GenParser Char st String
def_or_draw = GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"define") GenParser Char st String
-> GenParser Char st String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"draw")

def_types :: GenParser Char st String
def_types :: GenParser Char st String
def_types = GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"category") GenParser Char st String
-> GenParser Char st String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"functor") GenParser Char st String
-> GenParser Char st String -> GenParser Char st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char st String
forall st. GenParser Char st String
nat_trans_words

nat_trans_words :: GenParser Char st String
nat_trans_words :: GenParser Char st String
nat_trans_words = (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"natural" GenParser Char st String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> GenParser Char st String -> GenParser Char st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"transformation")

disp_string_parser :: GenParser Char st String
disp_string_parser :: GenParser Char st String
disp_string_parser = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> GenParser Char st String
-> GenParser Char st String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"') (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"') (ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char -> GenParser Char st String)
-> ParsecT String st Identity Char -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"")

options_parser :: GenParser Char st String
options_parser :: GenParser Char st String
options_parser = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> GenParser Char st String
-> GenParser Char st String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char -> GenParser Char st String)
-> ParsecT String st Identity Char -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"[]")

id_parser:: GenParser Char st String
id_parser :: GenParser Char st String
id_parser = ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char -> GenParser Char st String)
-> ParsecT String st Identity Char -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
x -> (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"&\\[]")

shape_parser :: GenParser Char st String
shape_parser :: GenParser Char st String
shape_parser = ParsecT String st Identity Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum

category_parser :: GenParser Char st SDCommand
category_parser :: GenParser Char st SDCommand
category_parser = do String
cid <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                     String
ds <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
disp_string_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                     SDCommand -> GenParser Char st SDCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (SDCommand -> GenParser Char st SDCommand)
-> SDCommand -> GenParser Char st SDCommand
forall a b. (a -> b) -> a -> b
$ String -> String -> SDCommand
DefineCat String
cid String
ds

functor_parser :: GenParser Char st SDCommand
functor_parser :: GenParser Char st SDCommand
functor_parser = do String
f_id <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                    String
ds <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
disp_string_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                    String
source_id <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"source" ParsecT String st Identity String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String st Identity Char
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                    String
target_id <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"target" ParsecT String st Identity String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String st Identity Char
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                    String
opts <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
options_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                    SDCommand -> GenParser Char st SDCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (SDCommand -> GenParser Char st SDCommand)
-> SDCommand -> GenParser Char st SDCommand
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> SDCommand
DefineFunc String
f_id String
ds String
source_id String
target_id String
opts

nat_trans_parser :: GenParser Char st SDCommand
nat_trans_parser :: GenParser Char st SDCommand
nat_trans_parser = do String
nt_id <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                      String
ds <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
disp_string_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                      [CompElement]
source_ids <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"source" ParsecT String st Identity String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' 
                                        ParsecT String st Identity Char
-> ParsecT String st Identity [CompElement]
-> ParsecT String st Identity [CompElement]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity CompElement
-> ParsecT String st Identity Char
-> ParsecT String st Identity [CompElement]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String st Identity CompElement
forall st. GenParser Char st CompElement
cell_parser (ParsecT String st Identity Char -> ParsecT String st Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity Char
 -> ParsecT String st Identity Char)
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&')
                      ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\"
                      [CompElement]
target_ids <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"target" ParsecT String st Identity String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' 
                                        ParsecT String st Identity Char
-> ParsecT String st Identity [CompElement]
-> ParsecT String st Identity [CompElement]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity CompElement
-> ParsecT String st Identity Char
-> ParsecT String st Identity [CompElement]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String st Identity CompElement
forall st. GenParser Char st CompElement
cell_parser (ParsecT String st Identity Char -> ParsecT String st Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity Char
 -> ParsecT String st Identity Char)
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&')
                      ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\"
                      String
opts <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
options_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                      String
shape <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"shape" ParsecT String st Identity String
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' ParsecT String st Identity Char
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
shape_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                      SDCommand -> GenParser Char st SDCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (SDCommand -> GenParser Char st SDCommand)
-> SDCommand -> GenParser Char st SDCommand
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [CompElement]
-> [CompElement]
-> String
-> String
-> SDCommand
DefineNat String
nt_id String
ds [CompElement]
source_ids [CompElement]
target_ids String
opts String
shape

def_parser :: GenParser Char st SDCommand
def_parser :: GenParser Char st SDCommand
def_parser = ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
def_types ParsecT String st Identity String
-> (String -> GenParser Char st SDCommand)
-> GenParser Char st SDCommand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> GenParser Char st SDCommand
forall st. String -> GenParser Char st SDCommand
def_controller
    where
        def_controller :: String -> GenParser Char st SDCommand
def_controller String
"category"       = GenParser Char st SDCommand
forall st. GenParser Char st SDCommand
category_parser
        def_controller String
"functor"        = GenParser Char st SDCommand
forall st. GenParser Char st SDCommand
functor_parser
        def_controller String
"transformation" = GenParser Char st SDCommand
forall st. GenParser Char st SDCommand
nat_trans_parser

entry_parser :: GenParser Char st SDCommand
entry_parser :: GenParser Char st SDCommand
entry_parser = GenParser Char st String
forall st. GenParser Char st String
def_or_draw GenParser Char st String
-> (String -> GenParser Char st SDCommand)
-> GenParser Char st SDCommand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> GenParser Char st SDCommand
forall st. String -> GenParser Char st SDCommand
entry_controller
    where
        entry_controller :: String -> GenParser Char st SDCommand
entry_controller String
"define" = GenParser Char st SDCommand
forall st. GenParser Char st SDCommand
def_parser
        entry_controller String
"draw"   = GenParser Char st SDCommand
forall st. GenParser Char st SDCommand
draw_parser

-- | 'sd_parser' is the parser which parses a @String@
-- into a list of @SDCommand@s.
sd_parser :: GenParser Char st [SDCommand]
sd_parser :: GenParser Char st [SDCommand]
sd_parser = ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> GenParser Char st [SDCommand] -> GenParser Char st [SDCommand]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity SDCommand
-> ParsecT String st Identity () -> GenParser Char st [SDCommand]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy ParsecT String st Identity SDCommand
forall st. GenParser Char st SDCommand
entry_parser ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces

cell_parser :: GenParser Char st CompElement
cell_parser :: GenParser Char st CompElement
cell_parser = do String
idm <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
id_parser
                 String
opt <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
options_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                 case String
idm of String
"" -> CompElement -> GenParser Char st CompElement
forall (m :: * -> *) a. Monad m => a -> m a
return CompElement
Empty
                             String
cid -> CompElement -> GenParser Char st CompElement
forall (m :: * -> *) a. Monad m => a -> m a
return (CompElement -> GenParser Char st CompElement)
-> CompElement -> GenParser Char st CompElement
forall a b. (a -> b) -> a -> b
$ String -> String -> CompElement
CompElement String
cid String
opt

f_or_n :: GenParser Char st StructureType
f_or_n :: GenParser Char st StructureType
f_or_n = do Char
fn <- String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"fn" ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
            case Char
fn of Char
'f' -> StructureType -> GenParser Char st StructureType
forall (m :: * -> *) a. Monad m => a -> m a
return StructureType
Func
                       Char
'n' -> StructureType -> GenParser Char st StructureType
forall (m :: * -> *) a. Monad m => a -> m a
return StructureType
Nat

draw_line_parser :: GenParser Char st SDDrawLine
draw_line_parser :: GenParser Char st SDDrawLine
draw_line_parser = do StructureType
fn <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity StructureType
-> ParsecT String st Identity StructureType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity StructureType
forall st. GenParser Char st StructureType
f_or_n
                      [CompElement]
parts <- ParsecT String st Identity CompElement
-> ParsecT String st Identity Char
-> ParsecT String st Identity [CompElement]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String st Identity CompElement
forall st. GenParser Char st CompElement
cell_parser (ParsecT String st Identity Char -> ParsecT String st Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity Char
 -> ParsecT String st Identity Char)
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'&')
                      case StructureType
fn of StructureType
Func -> SDDrawLine -> GenParser Char st SDDrawLine
forall (m :: * -> *) a. Monad m => a -> m a
return (SDDrawLine -> GenParser Char st SDDrawLine)
-> SDDrawLine -> GenParser Char st SDDrawLine
forall a b. (a -> b) -> a -> b
$ [CompElement] -> SDDrawLine
SDDrawFun [CompElement]
parts
                                 StructureType
Nat  -> SDDrawLine -> GenParser Char st SDDrawLine
forall (m :: * -> *) a. Monad m => a -> m a
return (SDDrawLine -> GenParser Char st SDDrawLine)
-> SDDrawLine -> GenParser Char st SDDrawLine
forall a b. (a -> b) -> a -> b
$ [CompElement] -> SDDrawLine
SDDrawNat [CompElement]
parts
 
draw_parser :: GenParser Char st SDCommand
draw_parser :: GenParser Char st SDCommand
draw_parser = do String
file_path <- ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity Char
 -> ParsecT String st Identity String)
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace))
                 String
opts <- ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String
forall st. GenParser Char st String
options_parser) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                 [SDDrawLine]
list <- ParsecT String st Identity SDDrawLine
-> ParsecT String st Identity String
-> ParsecT String st Identity [SDDrawLine]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy (ParsecT String st Identity SDDrawLine
-> ParsecT String st Identity SDDrawLine
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String st Identity SDDrawLine
forall st. GenParser Char st SDDrawLine
draw_line_parser) (ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String st Identity ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\")
                 SDCommand -> GenParser Char st SDCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (SDCommand -> GenParser Char st SDCommand)
-> SDCommand -> GenParser Char st SDCommand
forall a b. (a -> b) -> a -> b
$ String -> String -> [SDDrawLine] -> SDCommand
DrawNat String
file_path String
opts [SDDrawLine]
list