49 lines
1.5 KiB
Haskell
49 lines
1.5 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DerivingVia #-}
|
|
module Ubc.Parse.Syntax.File
|
|
( File(..)
|
|
, parse
|
|
)
|
|
where
|
|
|
|
import Control.Monad ((<$!>))
|
|
|
|
import Text.Parsec (choice, ParsecT, many)
|
|
|
|
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
|
|
import GHC.Generics (Generic)
|
|
import Data.Functor ((<&>))
|
|
|
|
data File = File
|
|
{ name :: String
|
|
, body :: FileBody
|
|
}
|
|
deriving (Show)
|
|
|
|
data FileBody = FileBody
|
|
{ structs :: [Struct]
|
|
, functions :: [Function]
|
|
, statements :: [Statement]
|
|
, enumerations :: [Enumeration]
|
|
}
|
|
deriving stock (Show, Generic)
|
|
deriving (Semigroup, Monoid) via FileBody
|
|
|
|
parse :: Monad m => ParsecT String u m File
|
|
parse = File "" <$!> mconcat <$!> many fileMember
|
|
|
|
fileMember :: Monad m => ParsecT String u m FileBody
|
|
fileMember = choice
|
|
[ Struct.parse <&> \s -> mempty { structs = [s] }
|
|
, Function.parse <&> \f -> mempty { functions = [f] }
|
|
, Statement.parse <&> \s -> mempty { statements = [s] }
|
|
, Enumeration.parse <&> \e -> mempty { enumerations = [e] }
|
|
]
|