Monoids for File construction

This commit is contained in:
VegOwOtenks 2025-02-13 21:56:22 +01:00
parent 4e8e5b9e84
commit b87917dc2e

View file

@ -1,3 +1,5 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
module Ubc.Parse.Syntax.File
( File(..)
, parse
@ -17,36 +19,31 @@ 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
import GHC.Generics (Generic)
import Data.Functor ((<&>))
data File = File
{ name :: String
, structs :: [Struct]
, body :: FileBody
}
deriving (Show)
data FileBody = FileBody
{ 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_ sss fs sts es) (FileStruct s) = File name_ (s:sss) fs sts es
accumulateFile (File name_ sss fs sts es) (FileFunction f) = File name_ sss (f:fs) sts es
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)
deriving stock (Show, Generic)
deriving (Semigroup, Monoid) via FileBody
parse :: Monad m => ParsecT String u m File
parse = foldr (flip accumulateFile) (File "" [] [] [] []) <$!> many fileMember
parse = File "" <$!> mconcat <$!> many fileMember
fileMember :: Monad m => ParsecT String u m FileMember
fileMember :: Monad m => ParsecT String u m FileBody
fileMember = choice
[ FileStruct <$!> Struct.parse
, FileFunction <$!> Function.parse
, FileStatement <$!> Statement.parse
, FileEnumeration <$!> Enumeration.parse
[ Struct.parse <&> \s -> mempty { structs = [s] }
, Function.parse <&> \f -> mempty { functions = [f] }
, Statement.parse <&> \s -> mempty { statements = [s] }
, Enumeration.parse <&> \e -> mempty { enumerations = [e] }
]