Struct Parsing continued, ditched multiple-errors support

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 
 dependencies:
 - base >= 4.7 && < 5
+- containers
 - parsec
 
 ghc-options:

src/Data/String/Ubc/Parse/Error/StructError.hs

@@ -1,11 +0,0 @@
-module Data.String.Ubc.Parse.Error.StructError
-( StructError(..)
-)
-where
-
-import Text.Parsec (SourcePos)
-
-data StructError = 
-          MissingNameError SourcePos
-        | MissingBraceError (Either SourcePos SourcePos) 
-        -- the either branch indicates which one is missing

src/Data/String/Ubc/Parse/ParserState.hs

@@ -2,6 +2,8 @@ module Data.String.Ubc.Parse.ParserState
 ( ParserState(..)
 , initialState
 , pushScope
+, popScope
+, modifyScope
 )
 where
 
@@ -16,3 +18,9 @@ initialState = ParserState []
 
 pushScope :: Scope -> ParserState -> ParserState
 pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = (scope : oldScopes)}
+
+popScope :: ParserState -> (ParserState, Scope)
+popScope oldState@ParserState{scopes = (topScope:restScopes)} = (oldState{scopes = restScopes}, topScope)
+
+modifyScope :: (Scope -> Scope) -> ParserState -> ParserState
+modifyScope f oldState@ParserState{scopes = (topScope:restScopes)} = oldState{scopes = (f topScope : restScopes)}

src/Data/String/Ubc/Parse/Scope.hs

@@ -1,5 +1,6 @@
 module Data.String.Ubc.Parse.Scope
 ( Scope(..)
+, expectScopeStruct
 )
 where
 
@@ -9,3 +10,6 @@ import Data.String.Ubc.Parse.StructScope (StructScope)
 data Scope = 
           ScopeFile FileScope
         | ScopeStruct StructScope
+
+expectScopeStruct (ScopeStruct s) = s
+expectScopeStruct _               = error "Internal Error: Top Scope is not Scope Struct"

src/Data/String/Ubc/Parse/Struct.hs

@@ -4,54 +4,69 @@ module Data.String.Ubc.Parse.Struct
 )
 where
 
+import Control.Arrow
+
 import Text.Parsec
 
-import Data.String.Ubc.Parse.StructVariable (StructVariable)
+import Data.Map (Map)
+import Data.String.Ubc.Parse.StructVariable (StructVariable(StructVariable))
 import Data.String.Ubc.Parse.ParserState (ParserState)
-import Data.String.Ubc.Parse.Error.StructError (StructError)
 import Data.String.Ubc.Parse.StructScope (StructScope(..))
 import Data.String.Ubc.Parse.Scope (Scope(..))
 
 import qualified Data.String.Ubc.Parse.Language as UbcLanguage
-import qualified Data.String.Ubc.Parse.Error.StructError as StructError
 import qualified Data.String.Ubc.Parse.StructScope as StructScope
 import qualified Data.String.Ubc.Parse.ParserState as ParserState
+import qualified Data.String.Ubc.Parse.Scope as Scope
+
+import qualified Data.Map as Map
 
 data Struct = Struct 
         { name :: String
-        , memberVariables :: [StructVariable]
+        , memberVariables :: Map String StructVariable
         }
+        deriving (Show)
 
-parseStruct :: Monad m => ParsecT String ParserState m (Either StructError Struct)
+parseStruct :: Monad m => ParsecT String ParserState m Struct
 parseStruct = do
         _ <- UbcLanguage.reserved "struct"
 
-        structName <- choice 
-                [ UbcLanguage.identifier >>= return . Right
-                , getPosition >>= return . Left . StructError.MissingNameError
-                ]
+        structIdentifier <- UbcLanguage.identifier
         let structScope = StructScope
-                { structName = either (const Nothing) (Just) structName 
-                , errors = []
+                { structName = structIdentifier 
+                , variables = Map.empty
                 }
 
-        updateState (ParserState.pushScope . ScopeStruct $ structScope)
+        modifyState (ParserState.pushScope . ScopeStruct $ structScope)
 
-        openingBrace <- choice
-                [ UbcLanguage.symbol "{" >>= return . Right
-                , getPosition >>= return . Left . StructError.MissingBraceError . Left
-                ]
+        _ <- UbcLanguage.braces (many structMember)
 
-        _ <- structMember `manyTill` (lookAhead $ choice [ eof, UbcLanguage.symbol "}" ])
+        structScope <- getState >>= return . Scope.expectScopeStruct . snd . ParserState.popScope
 
-        closingBrace <- choice
-                [ UbcLanguage.symbol "}" >>= return . Right
-                , getPosition >>= return . Left . StructError.MissingBraceError . Right
-                ]
-        return $ Right $ Struct "" []
+        return $ Struct (StructScope.structName structScope) (StructScope.variables structScope)
 
 structMember :: Monad m => ParsecT String ParserState m ()
 structMember = choice [ structVariableOrFunction ]
 
+structVariableOrFunction :: Monad m => ParsecT String ParserState m ()
 structVariableOrFunction = do
+        (typeName, identifier) <- try $ do
+                typeName <- UbcLanguage.identifier
+                objectIdentifier <- UbcLanguage.identifier
+                return $ (typeName, objectIdentifier)
+        choice 
+                [ lookAhead (char ';') *> parseVariable typeName identifier
+                ] -- TODO: Functions on structs
 
+parseVariable variableType variableName = do
+        _ <- UbcLanguage.semicolon
+        -- TODO: Validate type
+
+        (_, structScope) <- getState >>= return . (second Scope.expectScopeStruct) . ParserState.popScope
+        if (== Nothing) . Map.lookup variableName . StructScope.variables $ structScope
+        then do
+                -- variable is not yet defined on the struct
+                let structScope' = StructScope.modifyVariables (Map.insert variableName (StructVariable variableName variableType)) $ structScope
+                modifyState (ParserState.pushScope $ ScopeStruct structScope')
+        else do
+                unexpected $ "name: \"" ++ variableName ++ "\", this name is already defined"

src/Data/String/Ubc/Parse/StructScope.hs

@@ -1,11 +1,19 @@
 module Data.String.Ubc.Parse.StructScope
 ( StructScope(..)
+, modifyVariables
 )
 where
 
-import Data.String.Ubc.Parse.Error.StructError (StructError)
+import Data.Map (Map)
+
+import Data.String.Ubc.Parse.StructVariable (StructVariable)
 
 data StructScope = StructScope
-        { structName :: Maybe String
-        , errors :: [StructError]
+        { structName :: String
+        , variables :: Map String StructVariable
         }
+
+modifyVariables :: (Map String StructVariable -> Map String StructVariable) -> StructScope -> StructScope
+modifyVariables f scope@StructScope{variables = oldVariables} = scope{variables = newVariables}
+        where
+                newVariables = f oldVariables

src/Data/String/Ubc/Parse/StructVariable.hs

@@ -7,3 +7,5 @@ data StructVariable = StructVariable
         { name :: String
         , typeName :: String
         }
+        deriving (Show, Eq)
+

stack.yaml

@@ -17,8 +17,7 @@
 #
 # snapshot: ./custom-snapshot.yaml
 # snapshot: https://example.com/snapshots/2024-01-01.yaml
-snapshot:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml
+snapshot: ghc-9.8.2
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

stack.yaml.lock

@@ -1,13 +1,7 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
 
 packages: []
-snapshots:
-- completed:
-    sha256: 90719ee9e630cf0535cc349cb35e007cec11db9462d598be78cf8ecbabd12c6c
-    size: 679061
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml
-  original:
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/2.yaml
+snapshots: []

ubcc.cabal

@@ -26,7 +26,6 @@ source-repository head
 library
   exposed-modules:
       Data.String.Ubc.Parse
-      Data.String.Ubc.Parse.Error.StructError
       Data.String.Ubc.Parse.FileScope
       Data.String.Ubc.Parse.Language
       Data.String.Ubc.Parse.ParserState
@@ -43,6 +42,7 @@ library
   ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , containers
     , parsec
   default-language: Haskell2010
 
@@ -57,6 +57,7 @@ executable ubcc-exe
   ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , containers
     , parsec
     , ubcc
   default-language: Haskell2010
@@ -73,6 +74,7 @@ test-suite ubcc-test
   ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , containers
     , parsec
     , ubcc
   default-language: Haskell2010