From bc2ea0a384548aab50991c4de365f1afbad9a284 Mon Sep 17 00:00:00 2001
From: adelon <22380201+adelon@users.noreply.github.com>
Date: Tue, 7 May 2024 16:01:51 +0200
Subject: Sketch lexicon mechanism

---
 source/Syntax/LexiconFile.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 source/Syntax/LexiconFile.hs

(limited to 'source/Syntax')

diff --git a/source/Syntax/LexiconFile.hs b/source/Syntax/LexiconFile.hs
new file mode 100644
index 0000000..be70a6b
--- /dev/null
+++ b/source/Syntax/LexiconFile.hs
@@ -0,0 +1,58 @@
+module Syntax.LexiconFile where
+
+import Base hiding (many)
+import Syntax.Adapt
+import Syntax.LexicalPhrase
+import Syntax.Abstract
+
+import Data.Char (isAlphaNum, isAsciiLower, isLetter, isDigit)
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
+import Text.Earley.Mixfix (Holey)
+import Text.Megaparsec hiding (Token, Label, label)
+import Text.Megaparsec.Char qualified as Char
+import UnliftIO.Directory
+
+
+type LexiconFileParser = Parsec Void Text
+
+parseLexiconFile :: IO [ScannedLexicalItem]
+parseLexiconFile = do
+    currentDir  <- getCurrentDirectory
+    let csvPath = (currentDir <> "lexicon.csv")
+    csv <- Text.readFile csvPath
+    case runParser lexiconFile csvPath csv of
+        Left err -> fail (errorBundlePretty err)
+        Right entries -> pure entries
+
+lexiconFile :: LexiconFileParser [ScannedLexicalItem]
+lexiconFile = many line <* eof
+
+line :: LexiconFileParser ScannedLexicalItem
+line = do
+    c <- satisfy isAsciiLower
+    cs <- takeWhileP Nothing (\x -> isAsciiLower x || isDigit x || x == '_')
+    let marker = Marker (Text.cons c cs)
+    Char.char ','
+    kind <- takeWhile1P Nothing isLetter
+    Char.char ','
+    item <- case kind of
+        "adj" -> do
+            entry <- takeWhile1P Nothing (\x -> isAlphaNum x || x == '\'' || x == '-' || x == ' ')
+            pure (ScanAdj (unsafeReadPhrase (Text.unpack entry)) marker)
+        "rel" -> do
+            entry <- tokenSingle
+            pure (ScanRelationSymbol entry marker)
+        "const" -> do
+            entry <- tokenPattern
+            pure (ScanFunctionSymbol entry marker)
+        _ -> error "Unrecognized lexical item kind in lexicon file."
+    optional Char.eol
+    pure item
+
+tokenSingle :: LexiconFileParser Token
+tokenSingle = Command <$> (single '\\' *> takeWhile1P Nothing (\x -> isAlphaNum x))
+
+-- TODO allow spaces
+tokenPattern :: LexiconFileParser (Holey Token)
+tokenPattern = some (Just <$> tokenSingle <|> Nothing <$ single '?')
-- 
cgit v1.2.3