Add exceptions, global config

3 files changed, 63 insertions, 18 deletions

diff --git a/src/Lib.hs b/src/Lib.hs
index b9ad7bb..7235c7e 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,10 +1,16 @@
-module Lib
-    ( runScriptFile
-    ) where
+module Lib (
+    runScriptFile,
+    LContext
+) where
 
 import qualified Data.Map as M
 import qualified Data.Bifunctor as B
+import Control.Monad.Except
+import Control.Monad.Reader
+import Data.List
 import Debug.Trace
+import Types
+import Utils
 
 data AST
     = ASTNumber Double
@@ -15,25 +21,40 @@ data AST
     | ASTHashMap (M.Map AST AST)
     | ASTFunction (AST -> AST)
 
-_tokenize :: [String] -> String -> String -> [String]
+instance (Show AST) where
+    show (ASTNumber n) = show n
+    show (ASTSymbol s) = show s
+    show (ASTBoolean b) = show b
+    show (ASTString s) = show s
+    show (ASTVector v) = "[" ++ intercalate " " (map show v) ++ "]"
+    show (ASTHashMap m) =
+        let flattenMap = M.assocs .> map (\(k, v) -> [k, v]) .> concat
+         in "[" ++ intercalate " " (map show $ flattenMap m) ++ "]"
+    show (ASTFunction _) = "<fn>"
+
+_tokenize :: [String] -> String -> String -> LContext [String]
 _tokenize acc current src = case src of
-    "" -> reverse current : acc
+    "" -> return $ reverse current : acc
     (x:xs)
         | x == ';' ->
             let commentDropped = dropWhile (\c -> c /= '\n') xs
              in _tokenize (reverse current : acc) "" commentDropped
         | x == '"' ->
-            let consume :: String -> (String, Int)
+            -- String length -1 signals an unbalanced error
+            let inc k n = if n == -1 then -1 else n + k
+                consume :: String -> (String, Int)
                 consume str = case str of
-                    ('\\':'"':rest) -> B.bimap ('\"' :) (+ 2) (consume rest)
-                    ('\\':'n':rest) -> B.bimap ('\n' :) (+ 2) (consume rest)
-                    ('\\':'t':rest) -> B.bimap ('\t' :) (+ 2) (consume rest)
+                    ('\\':'"':rest) -> B.bimap ('\"' :) (inc 2) (consume rest)
+                    ('\\':'n':rest) -> B.bimap ('\n' :) (inc 2) (consume rest)
+                    ('\\':'t':rest) -> B.bimap ('\t' :) (inc 2) (consume rest)
                     ('"':_) -> ("", 1)
-                    (c:rest) -> B.bimap (c :) (+ 1) (consume rest)
-                    [] -> error "Unbalanced string literal"
+                    (c:rest) -> B.bimap (c :) (inc 1) (consume rest)
+                    [] -> ("", -1)
                 (string, stringLength) = consume xs
                 stringDropped = drop (stringLength) xs
-             in _tokenize (string : acc) "" stringDropped
+             in do
+                when (stringLength == -1) $ throwError (LException "Unbalanced string literal")
+                _tokenize (string : acc) "" stringDropped
         | x `elem` [' ', '\n', '\t', '\r'] ->
             _tokenize (reverse current : acc) "" xs
         | x `elem` ['(', ')', '[', ']', '{', '}', '\\'] ->
@@ -41,16 +62,21 @@ _tokenize acc current src = case src of
         | otherwise ->
             _tokenize acc (x : current) xs
 
-tokenize :: String -> [String]
-tokenize = filter (\t -> length t > 0) . reverse . _tokenize [] ""
+tokenize :: String -> LContext [String]
+tokenize src = do
+    tokens <- _tokenize [] "" src
+    return $ tokens
+        $> reverse
+        .> filter (\s -> length s > 0)
 
 parse :: [String] -> [AST]
 parse src = []
 
-runScriptFile :: String -> IO ()
+runScriptFile :: String -> LContext ()
 runScriptFile fileName = do
-    src <- readFile fileName
-    let tokenized = tokenize src
-    putStrLn $ "tokenized:\t\t" ++ show tokenized
+    src <- liftIO $ readFile fileName
+    tokenized <- tokenize src
+    config <- ask
+    when (configVerboseMode config) $ liftIO $ putStrLn $ "tokenized:\t\t" ++ show tokenized
     let parsed = parse tokenized
     return ()
diff --git a/src/Types.hs b/src/Types.hs
new file mode 100644
index 0000000..94428b6
--- /dev/null
+++ b/src/Types.hs
@@ -0,0 +1,13 @@
+module Types where
+
+import Control.Monad.Except
+import Control.Monad.Reader
+
+newtype LException = LException String
+data Config = Config {
+    configScriptFileName :: Maybe String,
+    configVerboseMode :: Bool,
+    configShowHelp :: Bool
+}
+
+type LContext a = ReaderT Config (ExceptT LException IO) a
diff --git a/src/Utils.hs b/src/Utils.hs
new file mode 100644
index 0000000..2497c9f
--- /dev/null
+++ b/src/Utils.hs
@@ -0,0 +1,6 @@
+module Utils where
+
+(.>) = flip (.)
+($>) = flip ($)
+
+infixr 6 $>