module Ast.Parser.TypeDefinition where
import qualified Ast.Parser.State as PS
import qualified Ast.Parser.Type as T
import qualified Ast.Parser.Utils as PU
import qualified Ast.Types as AT
import qualified Control.Monad.State as S
import qualified Text.Megaparsec as M
parseTypeDefinition :: PU.Parser AT.Type
parseTypeDefinition :: Parser Type
parseTypeDefinition =
[Parser Type] -> Parser Type
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
[ Parser Type -> Parser Type
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Type
structType,
Parser Type -> Parser Type
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Type
unionType,
Parser Type
typedefType
]
structType :: PU.Parser AT.Type
structType :: Parser Type
structType = do
String
name <- Parser String
PU.identifier
String
_ <- String -> Parser String
PU.symbol String
"::" Parser String -> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
PU.symbol String
"struct"
[(String, Type)]
fields <- Parser String
-> Parser String
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String -> Parser String
PU.symbol String
"{") (String -> Parser String
PU.symbol String
"}") (ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)])
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall a b. (a -> b) -> a -> b
$ ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
parseField
let newStructType :: Type
newStructType = AT.TStruct {structName :: String
AT.structName = String
name, fields :: [(String, Type)]
AT.fields = [(String, Type)]
fields}
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertType String
name Type
newStructType)
Type -> Parser Type
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
newStructType
unionType :: PU.Parser AT.Type
unionType :: Parser Type
unionType = do
String
name <- Parser String
PU.identifier
String
_ <- String -> Parser String
PU.symbol String
"::" Parser String -> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
PU.symbol String
"union"
[(String, Type)]
variants <- Parser String
-> Parser String
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String -> Parser String
PU.symbol String
"{") (String -> Parser String
PU.symbol String
"}") (ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)])
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall a b. (a -> b) -> a -> b
$ ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [(String, Type)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
parseField
let newUnionType :: Type
newUnionType = AT.TUnion {unionName :: String
AT.unionName = String
name, variants :: [(String, Type)]
AT.variants = [(String, Type)]
variants}
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertType String
name Type
newUnionType)
Type -> Parser Type
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
newUnionType
typedefType :: PU.Parser AT.Type
typedefType :: Parser Type
typedefType = do
String
name <- Parser String
PU.identifier
String
_ <- String -> Parser String
PU.symbol String
"::"
Type
parentType <- Parser Type
T.parseType
let typedef :: Type
typedef = String -> Type -> Type
AT.TTypedef String
name Type
parentType
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertType String
name Type
typedef)
Type -> Parser Type
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
typedef
parseField :: PU.Parser (String, AT.Type)
parseField :: ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
parseField = do
String
fieldName <- Parser String -> Parser String
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
PU.lexeme Parser String
PU.identifier
String
_ <- String -> Parser String
PU.symbol String
"->"
Type
fieldType <- Parser Type
T.parseType
(String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fieldName, Type
fieldType)