packages feed

cspmchecker 0.1.2 → 0.2.0

raw patch · 4 files changed

+265/−17 lines, 4 filesdep +haskelinedep ~libcspmnew-component:exe:cspmcheckeri

Dependencies added: haskeline

Dependency ranges changed: libcspm

Files

cspmchecker.cabal view
@@ -10,7 +10,7 @@ Build-type: Simple Cabal-version: >=1.9.2 Synopsis: A command line type checker for CSPM files.-Version: 0.1.2+Version: 0.2.0  Source-Repository head     type:     git@@ -21,7 +21,7 @@     type:     git     location: git://github.com/tomgr/libcspm.git     subdir:   cspmchecker-    tag: release-0.1.2+    tag: release-0.2.0    Executable cspmchecker     Main-is: Main.hs@@ -31,23 +31,23 @@      Build-depends:          base >= 4 && < 5,-        libcspm >= 0.1.2,+        libcspm >= 0.2.0,         filepath >= 1.2,         mtl >= 2.0,         directory >= 1.0          Hs-Source-Dirs: src/Checker ---Executable cspmcheckeri---    Main-is: Main.hs---    Other-modules: Monad---  ---    Build-depends: ---        base >= 4 && < 5,---        libcspm,---        filepath >= 1.2, ---        mtl >= 2.0,---        directory >= 1.0,---        haskeline >= 0.6---  ---    Hs-Source-Dirs: src/InteractiveChecker+Executable cspmcheckeri+    Main-is: Main.hs+    Other-modules: Monad+  +    Build-depends: +        base >= 4 && < 5,+        libcspm,+        filepath >= 1.2, +        mtl >= 2.0,+        directory >= 1.0,+        haskeline >= 0.6+  +    Hs-Source-Dirs: src/InteractiveChecker
src/Checker/Main.hs view
@@ -49,7 +49,8 @@     liftIO $ putStr $ "Checking "++fp++"....."     res <- tryM $ do         ms <- parseFile fp-        typeCheckFile ms+        rms <- CSPM.renameFile ms+        typeCheckFile rms         return ()     ws <- getState lastWarnings     resetCSPM
+ src/InteractiveChecker/Main.hs view
@@ -0,0 +1,193 @@+module Main where++import Data.Char+import Control.Exception (AsyncException(..))+import Control.Monad.Trans+import Data.List+import Prelude hiding (catch)+import System.Console.Haskeline+import System.FilePath+import System.IO++import CSPM+import CSPM.Compiler.Processes+import Monad+import Util.Annotated+import Util.Exception+import Util.Monad+import Util.Prelude+import Util.PrettyPrint++main :: IO ()+main = do+    st <- initICheckerState+    -- Ensure the output is not buffered+    hSetBuffering stdout NoBuffering+    runIChecker st runICheckerInput++runICheckerInput :: IChecker ()+runICheckerInput = do+    settingsDir <- getState settingsDirectory+    let settings = setComplete iCheckerComplete $ defaultSettings {+            historyFile = Just $ +                joinPath [settingsDir, "interactive", "prompt_history"]+        }+    runInputT settings interactiveLoop++interactiveLoop :: InputT IChecker ()+interactiveLoop = do+    currentPath <- lift $ getState currentFilePath+    let +        prompt = case currentPath of+            Just fp -> last (splitPath fp)+            Nothing -> ""+    minput <- handleSourceError (Just "") (getInputLine (prompt ++ "> "))+    case minput of+        Nothing -> return ()+        Just input -> do+            c <- handleSourceError True (processInput input)+            if c then interactiveLoop else return ()++handleSourceError :: a -> InputT IChecker a -> InputT IChecker a+handleSourceError v prog = (prog `catch` handle v) `catch` handleInt v+    where+        handle :: a -> LibCSPMException -> InputT IChecker a+        handle v e = do+            printError (show e)+            return v+        handleInt :: a -> AsyncException -> InputT IChecker a +        handleInt v UserInterrupt = do+            printError "Interrupted"+            return v++processInput :: String -> InputT IChecker Bool+processInput (':':str) = do+    let (cmd,rest) = break isSpace str+    case getCommand cmd of+        Just (_, f, _) -> f (dropWhile isSpace rest)+        Nothing -> do+            printError ("unknown command :"++ str)+            return True+processInput expr = +    if dropWhile isSpace expr == "" then return True+    else keepGoing evaluate expr++type CommandFunc = String -> InputT IChecker Bool+type Command = (String, CommandFunc, CompletionFunc IChecker)++builtInCommands :: [Command]+builtInCommands = [+    ("load", keepGoing loadFileCommand, completeFilename),+    ("printProc", keepGoing printProcCommand, completeExpression),+    ("reload", keepGoing reload, noCompletion),+    ("type", keepGoing typeOfExpr, completeExpression),+    ("quit", quit, noCompletion)+    ]++getCommand :: String -> Maybe Command+getCommand cmd = +    case getCommands cmd of+        c@(s,_,_):[] -> Just c+        _    -> Nothing++getCommands :: String -> [Command]+getCommands str = +    [c | c@(n,_,_) <- builtInCommands, str `isPrefixOf` n]++-- Completers+lineBreakers :: [Char]+lineBreakers = " \t\n"+expressionBreakers :: [Char]+expressionBreakers = +    lineBreakers +    ++ "+/%*?!$.(),;[]{}\\|"++wrapCompleter :: [Char] -> (String -> IChecker [String]) -> CompletionFunc IChecker+wrapCompleter breakers fun = completeWord Nothing breakers+    $ fmap (map simpleCompletion) . fmap sort . fun++iCheckerComplete :: CompletionFunc IChecker+iCheckerComplete line@(left,_) =+    case firstWord of+        ':':cmd | null rest -> completeCommand line+                | otherwise -> (lookupCompleter cmd) line+        _                   -> completeExpression line+    where+        (firstWord,rest) = break isSpace $ dropWhile isSpace $ reverse left+        lookupCompleter cmd = +            case getCommand cmd of+                Just (_,_,c) -> c+                Nothing -> noCompletion++completeCommand :: CompletionFunc IChecker+completeCommand = wrapCompleter lineBreakers $ +    \str -> case str of+        ':':cmd -> return (map (\ (s,_,_) -> ':':s) (getCommands cmd))+        _       -> return []++completeExpression :: CompletionFunc IChecker+completeExpression = wrapCompleter expressionBreakers $ \str -> do+    ns <- getBoundNames+    return [s | n <- ns, let OccName s = nameOccurrence n, str `isPrefixOf` s]+    +-- Commands++keepGoing :: (String -> InputT IChecker a) -> String -> InputT IChecker Bool+keepGoing prog str = prog str >> return True++quit :: String -> InputT IChecker Bool+quit _ = return False++typeOfExpr :: String ->  InputT IChecker ()+typeOfExpr str = do+    pExpr <- parseExpression str+    rnExpr <- renameExpression pExpr+    typ <- typeOfExpression rnExpr+    outputStrLn $ show $ +        text str <+> text "::" <+> prettyPrint typ+    return ()++loadFileCommand :: String -> InputT IChecker ()+loadFileCommand fname = do+    fname <- liftIO $ expandPathIO (trim fname)+    -- Reset the context+    lift resetCSPM+    lift $ modifyState (\st -> st { currentFilePath = Just fname })+    -- Handle the error here so that the filepath is remembered (for reloading)+    handleSourceError () $ do+        pFile <- parseFile fname+        rnFile <- renameFile pFile+        tcFile <- typeCheckFile rnFile+        dsFile <- desugarFile tcFile+        bindFile dsFile+        outputStrLn $ "Ok, loaded "++fname++reload :: String -> InputT IChecker ()+reload _ = do+    lift resetCSPM+    currentPath <- lift $ getState currentFilePath+    case currentPath of+        Just fp -> loadFileCommand fp+        Nothing -> return ()++evaluate :: String -> InputT IChecker ()+evaluate str = do+    pStmt <- parseInteractiveStmt str+    rnStmt <- renameInteractiveStmt pStmt+    tcStmt <- typeCheckInteractiveStmt rnStmt+    dsStmt <- desugarInteractiveStmt tcStmt+    case (unAnnotate dsStmt) of+        Bind d -> bindDeclaration d+        Evaluate e -> do+            v <- evaluateExpression e+            outputStrLn $ show $ prettyPrint v++printProcCommand :: String -> InputT IChecker ()+printProcCommand str = do+    pExpr <- parseExpression str+    rnExpr <- renameExpression pExpr+    tcExpr <- ensureExpressionIsOfType TProc rnExpr+    dsExpr <- desugarExpression tcExpr+    VProc p <- evaluateExpression dsExpr+    outputStrLn $ show $ prettyPrintAllRequiredProcesses p+    return ()
+ src/InteractiveChecker/Monad.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+module Monad where++import Control.Monad.State+import System.Console.Haskeline+import System.Directory+import System.FilePath++import CSPM+import Util.Exception+import Util.PrettyPrint++data ICheckerState = ICheckerState {+        settingsDirectory :: FilePath,+        cspmSession :: CSPMSession,+        currentFilePath :: Maybe FilePath+    }++initICheckerState :: IO ICheckerState+initICheckerState = do+    settingsDirectory <- getAppUserDataDirectory "cspmchecker"+    createDirectoryIfMissing True $ joinPath [settingsDirectory, "interactive"]+    sess <- newCSPMSession+    return $ ICheckerState settingsDirectory sess Nothing++resetCSPM :: IChecker ()+resetCSPM = do+    sess <- liftIO $ newCSPMSession+    modify (\st -> st { cspmSession = sess })++type IChecker = StateT ICheckerState IO++runIChecker :: ICheckerState -> IChecker a -> IO a+runIChecker st a = runStateT a st >>= return . fst++getState :: (ICheckerState -> a) -> IChecker a+getState = gets++modifyState :: (ICheckerState -> ICheckerState) -> IChecker ()+modifyState = modify++instance CSPMMonad IChecker where+    getSession = gets cspmSession+    setSession s = modify (\ st -> st { cspmSession = s })+    handleWarnings = panic "Cannot handle warnings here in a pure IChecker Monad"++instance CSPMMonad (InputT IChecker) where+    setSession = lift . setSession+    getSession = lift getSession+    handleWarnings ms = printError $ show $ prettyPrint ms++printError :: String -> InputT IChecker ()+printError s = outputStrLn $ "\ESC[1;31m\STX"++s++"\ESC[0m\STX" +