From 311c695aa30f63fc1be0ef8b8c56ca372e01a31e Mon Sep 17 00:00:00 2001
From: Brad Richardson <everythingfunctional@protonmail.com>
Date: Thu, 15 Oct 2020 10:47:40 -0500
Subject: Add test for a module's name

---
 bootstrap/src/BuildModel.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'bootstrap/src')

diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index 1610784..baefda9 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -46,6 +46,7 @@ data Source =
     { moduleSourceFileName :: FilePath
     , moduleObjectFileName :: FilePath -> FilePath
     , moduleModulesUsed :: [String]
+    , moduleName :: String
     }
 
 processRawSource :: RawSource -> Source
@@ -64,6 +65,7 @@ processRawSource rawSource =
           then Module { moduleSourceFileName = sourceFileName
                       , moduleObjectFileName = objectFileName
                       , moduleModulesUsed    = modulesUsed
+                      , moduleName           = getModuleName parsedContents
                       }
           else undefined
 
@@ -101,6 +103,13 @@ getModulesUsed = mapMaybe contentToMaybeModuleName
     ModuleUsed moduleName -> Just moduleName
     _                     -> Nothing
 
+getModuleName :: [LineContents] -> String
+getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc
+ where
+  contentToMaybeModuleName content = case content of
+    ModuleDeclaration moduleName -> Just moduleName
+    _                            -> Nothing
+
 readFileLinesIO :: FilePath -> IO [String]
 readFileLinesIO file = do
   contents <- readFile file
@@ -137,6 +146,7 @@ moduleDeclaration = do
   _ <- string "module"
   skipAtLeastOneWhiteSpace
   moduleName <- validIdentifier
+  skipSpaceCommentOrEnd
   return $ ModuleDeclaration moduleName
 
 useStatement :: ReadP LineContents
@@ -159,11 +169,19 @@ skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace
 skipSpaceCommaOrEnd :: ReadP ()
 skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace
 
+skipSpaceCommentOrEnd :: ReadP ()
+skipSpaceCommentOrEnd = eof <|> skipComment <|> skipAtLeastOneWhiteSpace
+
 skipComma :: ReadP ()
 skipComma = do
   _ <- char ','
   return ()
 
+skipComment :: ReadP ()
+skipComment = do
+  _ <- char '!'
+  return ()
+
 whiteSpace :: ReadP Char
 whiteSpace = satisfy (`elem` " \t")
 
-- 
cgit v1.2.3