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 module Ubc.Parse.Syntax.File
( File(..) ( File(..)
, parse , 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.Function as Function
import qualified Ubc.Parse.Syntax.Statement as Statement import qualified Ubc.Parse.Syntax.Statement as Statement
import qualified Ubc.Parse.Syntax.Enumeration as Enumeration import qualified Ubc.Parse.Syntax.Enumeration as Enumeration
import GHC.Generics (Generic)
import Data.Functor ((<&>))
data File = File data File = File
{ name :: String { name :: String
, structs :: [Struct] , body :: FileBody
}
deriving (Show)
data FileBody = FileBody
{ structs :: [Struct]
, functions :: [Function] , functions :: [Function]
, statements :: [Statement] , statements :: [Statement]
, enumerations :: [Enumeration] , enumerations :: [Enumeration]
} }
deriving (Show) deriving stock (Show, Generic)
deriving (Semigroup, Monoid) via FileBody
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)
parse :: Monad m => ParsecT String u m File 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 fileMember = choice
[ FileStruct <$!> Struct.parse [ Struct.parse <&> \s -> mempty { structs = [s] }
, FileFunction <$!> Function.parse , Function.parse <&> \f -> mempty { functions = [f] }
, FileStatement <$!> Statement.parse , Statement.parse <&> \s -> mempty { statements = [s] }
, FileEnumeration <$!> Enumeration.parse , Enumeration.parse <&> \e -> mempty { enumerations = [e] }
] ]