ubcc/src/Ubc/Parse/Syntax/Struct.hs

72 lines
2.3 KiB
Haskell

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
module Ubc.Parse.Syntax.Struct
( Struct(..)
, parse
)
where
-- yay, explicit dependency on ghc
import GHC.Generics (Generic, Generically(..))
import Control.Monad ((<$!>))
import Text.Parsec
( choice,
many,
try,
ParsecT,
)
import Ubc.Parse.Syntax.VariableType (VariableType)
import Ubc.Parse.Syntax.Function (Function)
import qualified Ubc.Parse.Syntax.Language as UbcLanguage
import qualified Ubc.Parse.Syntax.VariableType as VariableType
import qualified Ubc.Parse.Syntax.Function as Function
import qualified Ubc.Parse.Syntax.Generic as Syntax.Generic
type VariableName = String
data Struct = Struct
{ name :: String
, generics :: [Syntax.Generic.Generic]
, body :: StructBody
}
deriving (Show)
data StructBody = StructBody
{ variables :: [(VariableName, VariableType)]
, functions :: [Function]
}
deriving stock (Generic, Show)
deriving (Semigroup, Monoid) via Generically StructBody
parse :: Monad m => ParsecT String u m Struct
parse = do
_ <- UbcLanguage.reserved "struct"
structIdentifier <- UbcLanguage.identifier
structGenerics <- UbcLanguage.angles $ UbcLanguage.commaSeparated1 Syntax.Generic.parse
structBody <- mconcat <$!> UbcLanguage.braces (many structMember)
pure $ Struct structIdentifier structGenerics structBody
structMember :: Monad m => ParsecT String u m StructBody
structMember = choice [ structVariableOrFunction ]
structVariableOrFunction :: Monad m => ParsecT String u m StructBody
structVariableOrFunction = do
(typeName, identifier) <- try $ do
typeName <- UbcLanguage.typeName
objectIdentifier <- UbcLanguage.identifier
return (VariableType.fromString typeName, objectIdentifier)
choice
[ parseVariable typeName identifier
, (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier
]
parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructBody
parseVariable variableType variableName = do
_ <- UbcLanguage.semicolon
return $ mempty { variables = [(variableName, variableType)] }