From b87917dc2e44b65db921ea09ec1ca5acca3fb616 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 13 Feb 2025 21:56:22 +0100 Subject: [PATCH 1/2] Monoids for File construction --- src/Ubc/Parse/Syntax/File.hs | 43 +++++++++++++++++------------------- 1 file changed, 20 insertions(+), 23 deletions(-) diff --git a/src/Ubc/Parse/Syntax/File.hs b/src/Ubc/Parse/Syntax/File.hs index 6bd3d94..3b94785 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -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 +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 = choice - [ FileStruct <$!> Struct.parse - , FileFunction <$!> Function.parse - , FileStatement <$!> Statement.parse - , FileEnumeration <$!> Enumeration.parse +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] } ] - - From c12458a2bf18fc97b96570ff4fee879061526e91 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 13 Feb 2025 23:39:17 +0100 Subject: [PATCH 2/2] Fixed the infinite loop --- app/Main.hs | 2 +- src/Ubc/Parse/Syntax/File.hs | 9 +++++---- src/Ubc/Parse/Syntax/Struct.hs | 4 ++-- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index cbbd268..3900d7f 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 3b94785..2ee3026 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -19,7 +19,7 @@ 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 GHC.Generics (Generic, Generically(..)) import Data.Functor ((<&>)) data File = File @@ -35,10 +35,11 @@ data FileBody = FileBody , enumerations :: [Enumeration] } deriving stock (Show, Generic) - deriving (Semigroup, Monoid) via FileBody + deriving (Semigroup, Monoid) via Generically FileBody +-- dont use `deriving ... via FileBody` because that leads to a loop, somehow -parse :: Monad m => ParsecT String u m File -parse = File "" <$!> mconcat <$!> many fileMember +parse :: Monad m => String -> ParsecT String u m File +parse source = File source <$!> mconcat <$!> many fileMember fileMember :: Monad m => ParsecT String u m FileBody fileMember = choice diff --git a/src/Ubc/Parse/Syntax/Struct.hs b/src/Ubc/Parse/Syntax/Struct.hs index 03ab5ee..c8855b8 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) +import GHC.Generics (Generic, Generically(..)) import Control.Monad ((<$!>)) @@ -39,7 +39,7 @@ data StructBody = StructBody , functions :: [Function] } deriving stock (Generic, Show) - deriving (Semigroup, Monoid) via StructBody + deriving (Semigroup, Monoid) via Generically StructBody parse :: Monad m => ParsecT String u m Struct parse = do