Collecting the body of structs with monoids

app/Main.hs

@@ -6,4 +6,4 @@ main :: IO ()
 main = do
         text <- getContents
 
-        print $ Parsec.parse File.parse "<stdin>" text 
+        print $ Parsec.parse (File.parse <* Parsec.eof) "<stdin>" text 

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

@@ -1,23 +0,0 @@
-module Ubc.Parse.Syntax.Data.Struct
-( Struct(..)
-, addVariable
-, addFunction)
-where
-
-import Ubc.Parse.Syntax.VariableType (VariableType)
-import Ubc.Parse.Syntax.Function (Function)
-
-type VariableName = String
-
-data Struct = Struct 
-        { name :: String
-        , variables :: [(VariableName, VariableType)]
-        , functions :: [Function]
-        }
-        deriving (Show)
-
-addVariable :: Struct -> VariableName -> VariableType -> Struct
-addVariable (Struct sn vs fs) n t = Struct sn ((n, t): vs) fs
-
-addFunction :: Struct -> Function -> Struct
-addFunction (Struct sn vs fs) f = Struct sn vs (f:fs)

src/Ubc/Parse/Syntax/Enumeration.hs

@@ -0,0 +1,23 @@
+module Ubc.Parse.Syntax.Enumeration 
+( Enumeration(..)
+, parse
+)
+where
+import qualified Ubc.Parse.Syntax.Language as UbcLanguage
+import Text.Parsec (ParsecT, many, (<?>))
+
+type EnumerationMember = String
+data Enumeration = Enumeration 
+                        { name :: String
+                        , members :: [EnumerationMember]
+                        }
+                        deriving (Show)
+
+parse :: Monad m => ParsecT String u m Enumeration
+parse = do
+        UbcLanguage.reserved "enum"
+        identifier <- UbcLanguage.identifier <?> "enum identifier"
+        values <- UbcLanguage.braces $ many UbcLanguage.identifier
+
+        return $ Enumeration identifier values
+

src/Ubc/Parse/Syntax/File.hs

@@ -8,38 +8,45 @@ import Control.Monad ((<$!>))
 
 import Text.Parsec (choice, ParsecT, many)
 
-import Ubc.Parse.Syntax.Data.Struct ( Struct )
+import Ubc.Parse.Syntax.Struct ( Struct )
 import Ubc.Parse.Syntax.Function (Function)
 import Ubc.Parse.Syntax.Statement (Statement)
+import Ubc.Parse.Syntax.Enumeration (Enumeration)
+
 import qualified Ubc.Parse.Syntax.Struct as Struct
 import qualified Ubc.Parse.Syntax.Function as Function
 import qualified Ubc.Parse.Syntax.Statement as Statement
+import qualified Ubc.Parse.Syntax.Enumeration as Enumeration
 
 data File = File 
         { name :: String
         , structs :: [Struct]
         , functions :: [Function]
         , statements :: [Statement]
+        , enumerations :: [Enumeration]
         }
         deriving (Show)
 
 data FileMember = FileFunction Function
         | FileStruct Struct
+        | FileEnumeration Enumeration
         | FileStatement Statement
 
 accumulateFile :: File -> FileMember -> File
-accumulateFile (File name_ struct_ functions_ statements_) (FileFunction f)     = File name_    struct_  (f:functions_)    statements_
+accumulateFile (File name_ sss fs sts es) (FileStruct s)       = File name_ (s:sss) fs        sts     es
-accumulateFile (File name_ struct_ functions_ statements_) (FileStatement s)    = File name_    struct_  functions_     (s:statements_)
+accumulateFile (File name_ sss fs sts es) (FileFunction f)     = File name_    sss  (f:fs)    sts     es
-accumulateFile (File name_ struct_ functions_ statements_) (FileStruct s)       = File name_ (s:struct_) functions_        statements_
+accumulateFile (File name_ sss fs sts es) (FileStatement s)    = File name_    sss  fs     (s:sts)    es
+accumulateFile (File name_ sss fs sts es) (FileEnumeration e)  = File name_    sss  fs        sts  (e:es)
 
 parse :: Monad m => ParsecT String u m File
-parse = foldl accumulateFile (File "" [] [] []) <$!> many fileMember
+parse = foldr (flip accumulateFile) (File "" [] [] [] []) <$!> many fileMember
 
 fileMember :: Monad m => ParsecT String u m FileMember
 fileMember = choice 
                 [ FileStruct <$!> Struct.parse
                 , FileFunction <$!> Function.parse
                 , FileStatement <$!> Statement.parse
+                , FileEnumeration <$!> Enumeration.parse
                 ]
 
         

src/Ubc/Parse/Syntax/Language.hs

@@ -56,6 +56,7 @@ languageDef = LanguageDef {
         , opStart = oneOf "+-*/%"
         , opLetter = oneOf "+-*/%"
         , reservedNames =       [ "struct"
+                                , "enum"
                                 , "u32"
                                 , "i32"
                                 , "f32"

src/Ubc/Parse/Syntax/Struct.hs

@@ -1,9 +1,14 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Ubc.Parse.Syntax.Struct
 ( Struct(..)
 , parse
 )
 where
 
+-- yay, explicit dependency on ghc
+import GHC.Generics (Generic)
+
 import Control.Monad ((<$!>))
 
 import Text.Parsec
@@ -13,33 +18,41 @@ import Text.Parsec
       ParsecT,
       )
 
-import Ubc.Parse.Syntax.Data.Struct (Struct(..))
 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.Data.Struct as Struct
 import qualified Ubc.Parse.Syntax.Function as Function
 
 type VariableName = String
-data StructStatement = Variable VariableName VariableType
+
-        | Function Function.Function
+data Struct = Struct
+        { name :: String
+        , body :: StructBody
+        }
+        deriving (Show)
+
+data StructBody = StructBody
+        { variables :: [(VariableName, VariableType)]
+        , functions :: [Function]
+        }
+        deriving stock (Generic, Show)
+        deriving (Semigroup, Monoid) via StructBody
 
 parse :: Monad m => ParsecT String u m Struct
 parse = do
         _ <- UbcLanguage.reserved "struct"
         structIdentifier <- UbcLanguage.identifier
+        structBody       <- mconcat <$!> UbcLanguage.braces (many structMember)
 
-        foldl accumulateStruct (Struct structIdentifier [] []) <$!> UbcLanguage.braces (many structMember)
+        pure $ Struct structIdentifier structBody
 
-accumulateStruct :: Struct -> StructStatement -> Struct
+structMember :: Monad m => ParsecT String u m StructBody
-accumulateStruct s (Variable n t) = Struct.addVariable s n t
-accumulateStruct s (Function f) = Struct.addFunction s f
-
-structMember :: Monad m => ParsecT String u m StructStatement
 structMember = choice [ structVariableOrFunction ]
 
-structVariableOrFunction :: Monad m => ParsecT String u m StructStatement
+structVariableOrFunction :: Monad m => ParsecT String u m StructBody
 structVariableOrFunction = do
         (typeName, identifier) <- try $ do
                 typeName <- UbcLanguage.typeName
@@ -47,10 +60,10 @@ structVariableOrFunction = do
                 return (VariableType.fromString typeName, objectIdentifier)
         choice
                 [ parseVariable typeName identifier
-                , Function <$!> Function.parsePrefixed typeName identifier
+                , (\ f -> mempty { functions = [f] }) <$!> Function.parsePrefixed typeName identifier
-                ] -- TODO: Functions on structs
+                ]
 
-parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructStatement
+parseVariable :: Monad m => VariableType -> String -> ParsecT String u m StructBody
 parseVariable variableType variableName = do
         _ <- UbcLanguage.semicolon
-        return $ Variable variableName variableType
+        return $ mempty { variables = [(variableName, variableType)] }

src/Ubc/Parse/Syntax/TypeExpression.hs

@@ -9,7 +9,7 @@ import Control.Monad ((<$!>))
 import Text.Parsec (choice, ParsecT)
 
 import Ubc.Parse.Syntax.VariableType (VariableType)
-import Ubc.Parse.Syntax.Data.Struct (Struct)
+import Ubc.Parse.Syntax.Struct (Struct)
 
 import qualified Ubc.Parse.Syntax.Language as UbcLanguage
 import qualified Ubc.Parse.Syntax.VariableType as VariableType

ubcc.cabal

@@ -26,7 +26,7 @@ source-repository head
 library
   exposed-modules:
       Ubc.Parse.Syntax.Config
-      Ubc.Parse.Syntax.Data.Struct
+      Ubc.Parse.Syntax.Enumeration
       Ubc.Parse.Syntax.Expression
       Ubc.Parse.Syntax.File
       Ubc.Parse.Syntax.Function