Add exceptions, global config

6 files changed, 77 insertions, 27 deletions

diff --git a/app/Main.hs b/app/Main.hs
index a676a18..669a66e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,15 +1,10 @@
 module Main (main) where
 import System.Environment
-import Control.Monad
-
+import Control.Monad.Except
+import Control.Monad.Reader
+import Types
 import Lib
 
-data Config = Config {
-    configScriptFileName :: Maybe String,
-    configVerboseMode :: Bool,
-    configShowHelp :: Bool
-}
-
 parseArgs :: Config -> [String] -> Config
 parseArgs config args =
     case args of
@@ -40,7 +35,11 @@ main = do
         error "TODO help"
 
     case (configScriptFileName config) of
-        Just scriptFileName -> runScriptFile scriptFileName
+        Just scriptFileName -> do
+            result <- runExceptT $ runReaderT (runScriptFile scriptFileName) config
+            case result of
+                Left (LException ex) -> putStrLn $ "Error: " ++ ex
+                Right () -> return ()
         Nothing -> error "TODO REPL"
 
     return ()
diff --git a/lang.cabal b/lang.cabal
index 8651bf0..09fa5a1 100644
--- a/lang.cabal
+++ b/lang.cabal
@@ -26,6 +26,8 @@ source-repository head
 library
   exposed-modules:
       Lib
+      Types
+      Utils
   other-modules:
       Paths_lang
   hs-source-dirs:
@@ -34,6 +36,7 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
+    , mtl
   default-language: Haskell2010
 
 executable lang-exe
@@ -47,6 +50,7 @@ executable lang-exe
       base >=4.7 && <5
     , containers
     , lang
+    , mtl
   default-language: Haskell2010
 
 test-suite lang-test
@@ -61,4 +65,5 @@ test-suite lang-test
       base >=4.7 && <5
     , containers
     , lang
+    , mtl
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index e841945..0ac218c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 - containers
+- mtl
 
 ghc-options:
 - -Wall
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 $>