57 lines
1.8 KiB
Haskell
57 lines
1.8 KiB
Haskell
|
module Repl (repl) where
|
||
|
|
|
||
|
|
import Check
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import Expr
|
||
|
|
import Parser
|
||
|
|
import System.Console.Haskeline
|
||
|
|
import System.Directory (createDirectoryIfMissing, getHomeDirectory)
|
||
|
|
import System.FilePath ((</>))
|
||
|
|
|
||
|
|
newtype ReplState = ReplState
|
||
|
|
{ debugMode :: Bool
|
||
|
|
}
|
||
|
|
|
||
|
|
data ReplCommand = Quit | ToggleDebug | Input String deriving (Show)
|
||
|
|
|
||
|
|
parseCommand :: Maybe String -> Maybe ReplCommand
|
||
|
|
parseCommand Nothing = Nothing
|
||
|
|
parseCommand (Just ":q") = Just Quit
|
||
|
|
parseCommand (Just ":d") = Just ToggleDebug
|
||
|
|
parseCommand (Just input) = Just (Input input)
|
||
|
|
|
||
|
|
handleInput :: ReplState -> String -> InputT IO ()
|
||
|
|
handleInput state input = case pAll (T.pack input) of
|
||
|
|
Left err -> outputStrLn err
|
||
|
|
Right expr -> case findType [] expr of
|
||
|
|
Left err -> outputStrLn $ show err
|
||
|
|
Right ty ->
|
||
|
|
if debugMode state
|
||
|
|
then printDebugInfo expr ty
|
||
|
|
else outputStrLn $ prettyS ty
|
||
|
|
|
||
|
|
printDebugInfo :: Expr -> Expr -> InputT IO ()
|
||
|
|
printDebugInfo expr ty = do
|
||
|
|
outputStrLn $ "expr\t" ++ show expr
|
||
|
|
outputStrLn $ "type\t" ++ show ty
|
||
|
|
outputStrLn $ "type\t" ++ prettyS ty
|
||
|
|
|
||
|
|
repl :: IO ()
|
||
|
|
repl = do
|
||
|
|
home <- getHomeDirectory
|
||
|
|
let basepath = home </> ".cache" </> "perga"
|
||
|
|
let filepath = basepath </> "history"
|
||
|
|
createDirectoryIfMissing True basepath
|
||
|
|
runInputT (defaultSettings{historyFile = Just filepath}) $ loop (ReplState False)
|
||
|
|
where
|
||
|
|
loop :: ReplState -> InputT IO ()
|
||
|
|
loop state = do
|
||
|
|
minput <- getInputLine "> "
|
||
|
|
case parseCommand minput of
|
||
|
|
Nothing -> return ()
|
||
|
|
Just Quit -> return ()
|
||
|
|
Just ToggleDebug -> loop state{debugMode = not (debugMode state)}
|
||
|
|
Just (Input input) -> do
|
||
|
|
handleInput state input
|
||
|
|
loop state
|