Collecting the body of structs with monoids

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
@@ -23,37 +28,31 @@ import qualified Ubc.Parse.Syntax.Function as Function
 
 type VariableName = String
 
-data StructStatement = Variable VariableName VariableType
+data Struct = Struct
-        | Function Function.Function
-
-data Struct = Struct 
         { name :: String
-        , variables :: [(VariableName, VariableType)]
+        , body :: StructBody
-        , functions :: [Function]
         }
         deriving (Show)
 
-addVariable :: Struct -> VariableName -> VariableType -> Struct
+data StructBody = StructBody
-addVariable (Struct sn vs fs) n t = Struct sn ((n, t): vs) fs
+        { variables :: [(VariableName, VariableType)]
-
+        , functions :: [Function]
-addFunction :: Struct -> Function -> Struct
+        }
-addFunction (Struct sn vs fs) f = Struct sn vs (f:fs)
+        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) = addVariable s n t
-accumulateStruct s (Function f)   = 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
@@ -61,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)] }