REPL namespaces; lib function for pattern matching

Adds support for REPL namespacing, primarily to avoid `main` collisions.
Also adds a library function for an ergonomic pattern matching function
that I've been noodling on. I might explore ways to make list syntax
less annoying specifically for pattern matching like this.

.gitignore

@@ -9,3 +9,4 @@
 WD
 bin/
 dist*
+.tricu_history

flake.nix

@@ -34,6 +34,7 @@
         devShells.default = pkgs.mkShell {
           buildInputs = with pkgs; [
             haskellPackages.cabal-install
+            haskellPackages.ghc-events
             haskellPackages.ghcid
             customGHC
             upx

lib/patterns.tri

@@ -0,0 +1,35 @@
+!import "list.tri" !Local
+
+match_ = y (\self value patterns :
+  triage
+    t
+    (\_ : t)
+    (\pattern rest :
+      triage
+        t
+        (\_ : t)
+        (\test result :
+          if (test value)
+             (result value)
+             (self value rest))
+        pattern)
+    patterns)
+
+match = (\value patterns :
+  match_ value (map (\sublist :
+    pair (head sublist) (head (tail sublist)))
+    patterns))
+
+otherwise = const (t t)
+
+-- matchExample = (\x : match x [[(equal? 1)  (\_ : "one")]
+--                               [(equal? 2)  (\_ : "two")]
+--                               [(equal? 3)  (\_ : "three")]
+--                               [(equal? 4)  (\_ : "four")]
+--                               [(equal? 5)  (\_ : "five")]
+--                               [(equal? 6)  (\_ : "six")]
+--                               [(equal? 7)  (\_ : "seven")]
+--                               [(equal? 8)  (\_ : "eight")]
+--                               [(equal? 9)  (\_ : "nine")]
+--                               [(equal? 10) (\_ : "ten")]
+--                               [ otherwise  (\_ : "I ran out of fingers!")]])

src/FileEval.hs

@@ -6,6 +6,7 @@ import Parser
 import Research
 
 import Data.List       (partition)
+import Data.Maybe      (mapMaybe)
 import Control.Monad   (foldM)
 import System.IO
 import System.FilePath (takeDirectory, normalise, (</>))
@@ -13,6 +14,26 @@ import System.FilePath (takeDirectory, normalise, (</>))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
+extractMain :: Env -> Either String T
+extractMain env =
+  case Map.lookup "main" env of
+    Just result -> Right result
+    Nothing -> Left "No `main` function detected"
+
+processImports :: Set.Set FilePath -> FilePath -> FilePath -> [TricuAST]
+                 -> Either String ([TricuAST], [(FilePath, String, FilePath)])
+processImports seen base currentPath asts =
+  let (imports, nonImports) = partition isImp asts
+      importPaths = mapMaybe getImportInfo imports
+  in if currentPath `Set.member` seen
+     then Left $ "Encountered cyclic import: " ++ currentPath
+     else Right (nonImports, importPaths)
+  where
+    isImp (SImport _ _) = True
+    isImp _ = False
+    getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p)
+    getImportInfo _ = Nothing
+
 evaluateFileResult :: FilePath -> IO T
 evaluateFileResult filePath = do
   contents <- readFile filePath
@@ -20,11 +41,11 @@ evaluateFileResult filePath = do
   case parseProgram tokens of
     Left err -> errorWithoutStackTrace (handleParseError err)
     Right ast -> do
-      ast <- preprocessFile filePath
+      processedAst <- preprocessFile filePath
-      let finalEnv = evalTricu Map.empty ast
+      let finalEnv = evalTricu Map.empty processedAst
-      case Map.lookup "main" finalEnv of
+      case extractMain finalEnv of
-        Just finalResult -> return finalResult
+        Right result -> return result
-        Nothing -> errorWithoutStackTrace "No `main` function detected"
+        Left err -> errorWithoutStackTrace err
 
 evaluateFile :: FilePath -> IO Env
 evaluateFile filePath = do
@@ -50,38 +71,26 @@ preprocessFile :: FilePath -> IO [TricuAST]
 preprocessFile p = preprocessFile' Set.empty p p
 
 preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
-preprocessFile' s b p
+preprocessFile' seen base currentPath = do
-  | p `Set.member` s =
+  contents <- readFile currentPath
-      errorWithoutStackTrace $ "Encountered cyclic import: " ++ p
+  let tokens = lexTricu contents
-  | otherwise = do
+  case parseProgram tokens of
-      c <- readFile p
+    Left err -> errorWithoutStackTrace (handleParseError err)
-      let t = lexTricu c
+    Right ast ->
-      case parseProgram t of
+      case processImports seen base currentPath ast of
-        Left e -> errorWithoutStackTrace (handleParseError e)
+        Left err -> errorWithoutStackTrace err
-        Right a -> do
+        Right (nonImports, importPaths) -> do
-          let (i, n) = partition isImp a
+          let seen' = Set.insert currentPath seen
-          let s' = Set.insert p s
+          imported <- concat <$> mapM (processImportPath seen' base) importPaths
-          r <- concat <$>
+          pure $ imported ++ nonImports
-            mapM (procImp s' "" p) i
-          pure $ r ++ n
   where
-    isImp :: TricuAST -> Bool
+    processImportPath seen base (path, name, importPath) = do
+      ast <- preprocessFile' seen base importPath
+      pure $ map (nsDefinition (if name == "!Local" then "" else name))
+           $ filter (not . isImp) ast
     isImp (SImport _ _) = True
     isImp _ = False
 
-    procImp :: Set.Set FilePath -> String -> FilePath -> TricuAST -> IO [TricuAST]
-    procImp s m f (SImport p "!Local") = do
-      let ip = makeRelativeTo f p
-      a <- preprocessFile' s b ip
-      let d = filter (not . isImp) a
-      pure $ map (nsDefinition m) d
-    procImp s _ f (SImport p n) = do
-      let ip = makeRelativeTo f p
-      a <- preprocessFile' s b ip
-      let d = filter (not . isImp) a
-      pure $ map (nsDefinition n) d
-    procImp _ _ _ _ = error "Unexpected non-import in processImport"
-
 makeRelativeTo :: FilePath -> FilePath -> FilePath
 makeRelativeTo f i =
     let d = takeDirectory f

src/REPL.hs

@@ -9,18 +9,32 @@ import Research
 import Control.Exception         (SomeException, catch)
 import Control.Monad.IO.Class    (liftIO)
 import Control.Monad.Catch       (handle, MonadCatch)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
 import Data.Char                 (isSpace)
 import Data.List                 ( dropWhile
                                  , dropWhileEnd
-                              , intercalate
                                  , isPrefixOf)
 import System.Console.Haskeline
 
 import qualified Data.Map as Map
 
 repl :: Env -> IO ()
-repl env = runInputT defaultSettings (withInterrupt (loop env True))
+repl env = runInputT settings (withInterrupt (loop env True))
   where
+    settings :: Settings IO
+    settings = Settings
+      { complete = completeWord Nothing " \t" completeCommands
+      , historyFile = Just ".tricu_history"
+      , autoAddHistory = True
+      }
+
+    completeCommands :: String -> IO [Completion]
+    completeCommands str = return $ map simpleCompletion $
+      filter (str `isPrefixOf`) commands
+      where
+        commands = ["!exit", "!decode", "!definitions", "!import"]
+
     loop :: Env -> Bool -> InputT IO ()
     loop env decode = handle (interruptHandler env decode) $ do
       minput <- getInputLine "tricu < "
@@ -32,26 +46,48 @@ repl env = runInputT defaultSettings (withInterrupt (loop env True))
           | strip s == "!decode" -> do
               outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
               loop env (not decode)
-          | "!import" `isPrefixOf` strip s -> do
+          | strip s == "!definitions" -> do
-              let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s)
+              let defs = Map.keys $ Map.delete "!result" env
-              if not (null afterImport)
+              if null defs
-                then outputStrLn "Warning: REPL imports are interactive; \
+                then outputStrLn "No definitions discovered."
-                                  \additional arguments are ignored."
+                else do
-                else pure ()
+                  outputStrLn "Available definitions:"
-              path <- getInputLine "File path to load < "
+                  mapM_ outputStrLn defs
-              case path of
-                Nothing -> do
-                  outputStrLn "No input received; stopping import."
               loop env decode
-                Just p -> do
+          | "!import" `isPrefixOf` strip s -> handleImport env decode
-                  loadedEnv <- liftIO $ evaluateFileWithContext env
-                    (strip p) `catch` \e -> errorHandler env e
-                  loop (Map.delete "!result" (Map.union loadedEnv env)) decode
           | take 2 s == "--" -> loop env decode
           | otherwise -> do
               newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
               loop newEnv decode
 
+    handleImport :: Env -> Bool -> InputT IO ()
+    handleImport env decode = do
+      result <- runMaybeT $ do
+        let fileSettings = setComplete completeFilename defaultSettings
+        path <- MaybeT $ runInputT fileSettings $
+          getInputLineWithInitial "File path to load < " ("", "")
+
+        contents <- liftIO $ readFile (strip path)
+
+        if | Left err <- parseProgram (lexTricu contents) -> do
+               lift $ outputStrLn $ "Parse error: " ++ handleParseError err
+               MaybeT $ return Nothing
+           | Right ast <- parseProgram (lexTricu contents) -> do
+               ns <- MaybeT $ runInputT defaultSettings $
+                 getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
+
+               processedAst <- liftIO $ preprocessFile (strip path)
+               let namespacedAst | strip ns == "!Local" = processedAst
+                                | otherwise = nsDefinitions (strip ns) processedAst
+                   loadedEnv = evalTricu env namespacedAst
+               return loadedEnv
+
+      if | Nothing <- result -> do
+             outputStrLn "Import cancelled."
+             loop env decode
+         | Just loadedEnv <- result ->
+             loop (Map.delete "!result" loadedEnv) decode
+
     interruptHandler :: Env -> Bool -> Interrupt -> InputT IO ()
     interruptHandler env decode _ = do
       outputStrLn "Interrupted with CTRL+C\n\

tricu.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        0.14.0
+version:        0.15.0
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co
@@ -32,6 +32,7 @@ executable tricu
     , megaparsec
     , mtl
     , text
+    , transformers
   other-modules:
     Eval
     FileEval
@@ -63,6 +64,7 @@ test-suite tricu-tests
     , tasty-hunit
     , tasty-quickcheck
     , text
+    , transformers
   default-language:    Haskell2010
   other-modules:
     Eval