diff --git a/app/Main.hs b/app/Main.hs index 3900d7f..cbbd268 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,4 +6,4 @@ main :: IO () main = do text <- getContents - print $ Parsec.parse (File.parse "" <* Parsec.eof) "" text + print $ Parsec.parse (File.parse <* Parsec.eof) "" text diff --git a/src/Ubc/Parse/Syntax/File.hs b/src/Ubc/Parse/Syntax/File.hs index 2ee3026..6bd3d94 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} module Ubc.Parse.Syntax.File ( File(..) , parse @@ -19,32 +17,36 @@ 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, Generically(..)) -import Data.Functor ((<&>)) -data File = File +data File = File { name :: String - , body :: FileBody - } - deriving (Show) - -data FileBody = FileBody - { structs :: [Struct] + , structs :: [Struct] , functions :: [Function] , statements :: [Statement] , enumerations :: [Enumeration] } - deriving stock (Show, Generic) - deriving (Semigroup, Monoid) via Generically FileBody --- dont use `deriving ... via FileBody` because that leads to a loop, somehow + deriving (Show) -parse :: Monad m => String -> ParsecT String u m File -parse source = File source <$!> mconcat <$!> many fileMember +data FileMember = FileFunction Function + | FileStruct Struct + | FileEnumeration Enumeration + | FileStatement Statement -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] } +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 = 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 ] + + diff --git a/src/Ubc/Parse/Syntax/Struct.hs b/src/Ubc/Parse/Syntax/Struct.hs index c8855b8..03ab5ee 100644 --- a/src/Ubc/Parse/Syntax/Struct.hs +++ b/src/Ubc/Parse/Syntax/Struct.hs @@ -7,7 +7,7 @@ module Ubc.Parse.Syntax.Struct where -- yay, explicit dependency on ghc -import GHC.Generics (Generic, Generically(..)) +import GHC.Generics (Generic) import Control.Monad ((<$!>)) @@ -39,7 +39,7 @@ data StructBody = StructBody , functions :: [Function] } deriving stock (Generic, Show) - deriving (Semigroup, Monoid) via Generically StructBody + deriving (Semigroup, Monoid) via StructBody parse :: Monad m => ParsecT String u m Struct parse = do