tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

REPL.hs (10329B)

      1 module REPL where
      2 
      3 import Eval (evalTricu, result)
      4 import FileEval
      5   ( LoadedSource(..)
      6   , defaultStorePath
      7   , loadFileWithStore
      8   )
      9 import Parser (parseTricu)
     10 import Research (EvaluatedForm(..), Env, formatT)
     11 import ContentStore
     12   ( AliasKind(..)
     13   , ObjectRef(..)
     14   , StorePath(..)
     15   , cachedFilesystemResolver
     16   , getTreeTerm
     17   , readAlias
     18   , treeTermDomain
     19   , unDomain
     20   )
     21 import Module.Resolver (resolveModuleImport, resolvedModulesEnv)
     22 
     23 import Control.Exception (SomeException, catch, displayException)
     24 import Control.Monad.IO.Class (liftIO)
     25 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
     26 import Data.List (isPrefixOf, sort)
     27 import Data.Version (showVersion)
     28 import Paths_tricu (version)
     29 import System.Console.Haskeline
     30 import System.Directory (doesFileExist)
     31 
     32 import qualified Data.Map as Map
     33 import qualified Data.Text as T
     34 
     35 -- | Source-local REPL with the same filesystem CAS/module loader used by the
     36 -- CLI.
     37 data REPLState = REPLState
     38   { replForm   :: EvaluatedForm
     39   , replEnv    :: Env
     40   , replStore  :: StorePath
     41   , replEnvRef :: IORef Env
     42   }
     43 
     44 repl :: IO ()
     45 repl = defaultStorePath >>= replWithStore
     46 
     47 replWithStore :: StorePath -> IO ()
     48 replWithStore store = do
     49   envRef <- newIORef Map.empty
     50   let settings = Settings
     51         { complete = completeRepl envRef
     52         , historyFile = Just "~/.local/state/tricu/history"
     53         , autoAddHistory = True
     54         }
     55   runInputT settings (loop (REPLState Decode Map.empty store envRef))
     56   where
     57 
     58     loop :: REPLState -> InputT IO ()
     59     loop state = do
     60       minput <- getInputLine "tricu < "
     61       case minput of
     62         Nothing -> return ()
     63         Just raw -> do
     64           let s = strip raw
     65           case s of
     66             "" -> loop state
     67             "!exit" -> outputStrLn "Exiting tricu"
     68             "!clear" -> liftIO (putStr "\ESC[2J\ESC[H") >> loop state
     69             "!reset" -> do
     70               liftIO $ writeIORef (replEnvRef state) Map.empty
     71               outputStrLn "Environment reset"
     72               loop state { replEnv = Map.empty }
     73             "!help" -> printHelp >> loop state
     74             "!output" -> handleOutput state
     75             "!env" -> handleEnv state >> loop state
     76             _ | "!load" `isPrefixOf` s -> handleLoad state (strip $ drop 5 s)
     77               | "!use" `isPrefixOf` s -> handleUse state (strip $ drop 4 s)
     78               | "!name" `isPrefixOf` s -> handleName state (strip $ drop 5 s)
     79               | "!store" `isPrefixOf` s -> handleStore state (strip $ drop 6 s)
     80               | "!format" `isPrefixOf` s -> handleFormat state (strip $ drop 7 s)
     81               | take 2 s == "--" -> loop state
     82               | otherwise -> do
     83                   next <- liftIO $ catch (processInput state raw) (errorHandler state)
     84                   loop next
     85 
     86     printHelp :: InputT IO ()
     87     printHelp = do
     88       outputStrLn $ "tricu version " ++ showVersion version
     89       outputStrLn "Available commands:"
     90       outputStrLn "  !exit                  - Exit the REPL"
     91       outputStrLn "  !clear                 - Clear the screen"
     92       outputStrLn "  !reset                 - Reset the in-memory environment"
     93       outputStrLn "  !help                  - Show this help"
     94       outputStrLn "  !output                - Change output format interactively"
     95       outputStrLn "  !format FORM           - Set output format: tree, fsl, ast, ternary, ascii, decode, number, string"
     96       outputStrLn "  !load FILE             - Load and evaluate a .tri file into the environment"
     97       outputStrLn "  !use MODULE [NS]       - Load a module alias/manifest from the store (NS defaults to !Local)"
     98       outputStrLn "  !name NAME [LOCAL]     - Load a name alias/tree-term hash from the store"
     99       outputStrLn "  !store [PATH]          - Show or set the content-addressed store path"
    100       outputStrLn "  !env                   - List names currently in the REPL environment"
    101 
    102     handleOutput :: REPLState -> InputT IO ()
    103     handleOutput state = do
    104       let formats = outputFormats
    105       outputStrLn "Available output formats:"
    106       mapM_ (\(i, f) -> outputStrLn $ show (i :: Int) ++ ". " ++ show f)
    107         (zip [1..] formats)
    108       input <- getInputLine "Select output format (1-8) < "
    109       case input >>= readMaybeInt of
    110         Just n | n >= 1 && n <= length formats -> do
    111           let newForm = formats !! (n - 1)
    112           outputStrLn $ "Output format changed to: " ++ show newForm
    113           loop state { replForm = newForm }
    114         _ -> outputStrLn "Invalid selection. Keeping current output format." >> loop state
    115 
    116     handleFormat :: REPLState -> String -> InputT IO ()
    117     handleFormat state arg =
    118       case readEvaluatedForm arg of
    119         Just form -> outputStrLn ("Output format changed to: " ++ show form) >> loop state { replForm = form }
    120         Nothing -> outputStrLn "Usage: !format tree|fsl|ast|ternary|ascii|decode|number|string" >> loop state
    121 
    122     handleLoad :: REPLState -> String -> InputT IO ()
    123     handleLoad state path
    124       | null path = outputStrLn "Usage: !load FILE" >> loop state
    125       | otherwise = do
    126           exists <- liftIO $ doesFileExist path
    127           if not exists
    128             then outputStrLn ("File not found: " ++ path) >> loop state
    129             else do
    130               loaded <- liftIO $ loadFileWithStore (replStore state) path
    131               let env' = evalTricu (Map.union (loadedImports loaded) (replEnv state)) (loadedAst loaded)
    132               liftIO $ writeIORef (replEnvRef state) env'
    133               outputStrLn $ "Loaded " ++ path
    134               loop state { replEnv = env' }
    135 
    136     handleUse :: REPLState -> String -> InputT IO ()
    137     handleUse state arg = case words arg of
    138       [] -> outputStrLn "Usage: !use MODULE [NAMESPACE]" >> loop state
    139       [moduleTarget] -> loadModule moduleTarget "!Local"
    140       [moduleTarget, namespace] -> loadModule moduleTarget namespace
    141       _ -> outputStrLn "Usage: !use MODULE [NAMESPACE]" >> loop state
    142       where
    143         loadModule moduleTarget namespace = do
    144           resolver <- liftIO $ cachedFilesystemResolver (replStore state)
    145           resolved <- liftIO $ resolveModuleImport resolver moduleTarget namespace
    146           let importedEnv = resolvedModulesEnv [resolved]
    147               env' = Map.union importedEnv (replEnv state)
    148           liftIO $ writeIORef (replEnvRef state) env'
    149           outputStrLn $ "Loaded " ++ show (Map.size importedEnv) ++ " export(s) from store module " ++ moduleTarget
    150           loop state { replEnv = env' }
    151 
    152     handleName :: REPLState -> String -> InputT IO ()
    153     handleName state arg = case words arg of
    154       [] -> outputStrLn "Usage: !name NAME [LOCAL]" >> loop state
    155       [name] -> loadName name name
    156       [name, localName] -> loadName name localName
    157       _ -> outputStrLn "Usage: !name NAME [LOCAL]" >> loop state
    158       where
    159         loadName name localName = do
    160           let store = replStore state
    161               nameText = T.pack name
    162           mAlias <- liftIO $ readAlias store NameAlias nameText
    163           let root = maybe nameText objectRefHash mAlias
    164               badKind = case mAlias of
    165                 Just ref -> objectRefKind ref /= unDomain treeTermDomain
    166                 Nothing -> False
    167           if badKind
    168             then outputStrLn ("Name alias does not point at a tree term: " ++ name) >> loop state
    169             else do
    170               mTerm <- liftIO $ getTreeTerm store root
    171               case mTerm of
    172                 Nothing -> outputStrLn ("Tree term not found in store: " ++ name) >> loop state
    173                 Just term -> do
    174                   let env' = Map.insert localName term (replEnv state)
    175                   liftIO $ writeIORef (replEnvRef state) env'
    176                   outputStrLn $ "Loaded " ++ name ++ " as " ++ localName
    177                   loop state { replEnv = env' }
    178 
    179     handleStore :: REPLState -> String -> InputT IO ()
    180     handleStore state path
    181       | null path = do
    182           outputStrLn $ "Store: " ++ storePathString (replStore state)
    183           loop state
    184       | otherwise = do
    185           outputStrLn $ "Store changed to: " ++ path
    186           loop state { replStore = StorePath path }
    187 
    188     handleEnv :: REPLState -> InputT IO ()
    189     handleEnv state =
    190       case sort (Map.keys (replEnv state)) of
    191         [] -> outputStrLn "Environment is empty"
    192         names -> mapM_ outputStrLn names
    193 
    194     processInput :: REPLState -> String -> IO REPLState
    195     processInput state input = do
    196       let env' = evalTricu (replEnv state) (parseTricu input)
    197       writeIORef (replEnvRef state) env'
    198       putStrLn $ formatT (replForm state) (result env')
    199       return state { replEnv = env' }
    200 
    201     errorHandler :: REPLState -> SomeException -> IO REPLState
    202     errorHandler state e = do
    203       putStrLn $ "Error: " ++ displayException e
    204       return state
    205 
    206 completeRepl :: IORef Env -> CompletionFunc IO
    207 completeRepl envRef input@(left, _right)
    208   | commandWantsFile line = completeFilename input
    209   | "!" `isPrefixOf` line = completeWord Nothing " \t" completeCommands input
    210   | otherwise = completeWord Nothing termBreakChars completeTerms input
    211   where
    212     line = reverse left
    213     completeCommands str = return $ map simpleCompletion $
    214       filter (str `isPrefixOf`) commands
    215     completeTerms str = do
    216       env <- readIORef envRef
    217       return $ map simpleCompletion $
    218         filter (str `isPrefixOf`) (sort $ Map.keys env)
    219     commands =
    220       [ "!exit"
    221       , "!output"
    222       , "!format"
    223       , "!clear"
    224       , "!reset"
    225       , "!help"
    226       , "!load"
    227       , "!use"
    228       , "!name"
    229       , "!store"
    230       , "!env"
    231       ]
    232     commandWantsFile inputLine = "!load " `isPrefixOf` inputLine
    233     termBreakChars = " \t\n\r()[]{}\"'"
    234 
    235 outputFormats :: [EvaluatedForm]
    236 outputFormats = [Decode, Tree, FSL, AST, Ternary, Ascii, Number, StringLit]
    237 
    238 readEvaluatedForm :: String -> Maybe EvaluatedForm
    239 readEvaluatedForm s = case s of
    240   "tree"    -> Just Tree
    241   "fsl"     -> Just FSL
    242   "ast"     -> Just AST
    243   "ternary" -> Just Ternary
    244   "ascii"   -> Just Ascii
    245   "decode"  -> Just Decode
    246   "number"  -> Just Number
    247   "string"  -> Just StringLit
    248   _         -> Nothing
    249 
    250 storePathString :: StorePath -> FilePath
    251 storePathString (StorePath path) = path
    252 
    253 strip :: String -> String
    254 strip = f . f
    255   where f = reverse . dropWhile (`elem` [' ', '\t', '\n', '\r'])
    256 
    257 readMaybeInt :: String -> Maybe Int
    258 readMaybeInt s = case reads s of
    259   [(n, "")] -> Just n
    260   _ -> Nothing