hpage 0.3.1 → 0.3.2
raw patch · 9 files changed
+55/−120 lines, 9 filesdep +hint-server
Dependencies added: hint-server
Files
- hpage.cabal +6/−7
- src/HPage/Control.hs +8/−5
- src/HPage/GUI/FreeTextWindow.hs +1/−1
- src/HPage/Server.hs +1/−1
- src/HPage/Test/Server.hs +1/−1
- src/HPage/Utils/Log.hs +38/−0
- src/Language/Haskell/Interpreter/Server.hs +0/−53
- src/Language/Haskell/Interpreter/Utils.hs +0/−14
- src/Utils/Log.hs +0/−38
hpage.cabal view
@@ -1,5 +1,5 @@ name: hpage-version: 0.3.1+version: 0.3.2 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -34,11 +34,10 @@ Executable hpage build-depends: base >= 4, base < 5, mtl >=1.1.0, mtl < 1.2,+ monad-loops >=0.3.0, monad-loops < 0.4, haskell-src-exts >=1.1.3, haskell-src-exts < 1.2, bytestring >=0.9.1, bytestring <0.10,- hint >=0.3.1, hint < 0.4, MonadCatchIO-mtl >= 0.1.0, MonadCatchIO-mtl < 0.3,- monad-loops >=0.3.0, monad-loops < 0.4, containers >=0.2.0, containers < 0.3, directory >=1.0.0, directory < 1.1, wxcore >=0.11.1, wxcore < 0.12,@@ -46,7 +45,9 @@ filepath >=1.1.0, filepath < 1.2, Cabal >= 1.6, Cabal < 1.7, MissingH >= 1.1, MissingH < 1.2,- eprocess >= 1.0.0, eprocess < 2+ hint >=0.3.1, hint < 0.4,+ eprocess >= 1.0.0, eprocess < 2,+ hint-server >= 1.0.0, hint-server < 2 main-is: Main.hs buildable: True build-tools:@@ -68,9 +69,7 @@ HPage.Test.Extensions.FlexibleInstances, HPage.Test.Extensions.OverlappingInstances, HPage.Test.Extensions.TypeSynonymInstances,- Language.Haskell.Interpreter.Server,- Language.Haskell.Interpreter.Utils,- Utils.Log+ HPage.Utils.Log ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all -prof ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns
src/HPage/Control.hs view
@@ -45,7 +45,7 @@ loadPrefsFromCabal', reset, reset', cancel,- Hint.InterpreterError, Hint.prettyPrintError,+ Hint.InterpreterError, prettyPrintError, Hint.availableExtensions, Hint.Extension(..), ModuleElemDesc(..), -- DEBUG --@@ -65,9 +65,8 @@ import Language.Haskell.Interpreter (OptionVal((:=))) import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint-import qualified Language.Haskell.Interpreter.Utils as Hint import qualified Language.Haskell.Interpreter.Server as HS-import Utils.Log+import HPage.Utils.Log import Data.List (isPrefixOf) import Data.List.Utils import qualified Data.List as List@@ -679,8 +678,13 @@ liftIO $ HS.runIn hs $ recoveryLog ctx modify (\c -> c{server = hs, running = Nothing})- +prettyPrintError :: Hint.InterpreterError -> String+prettyPrintError (Hint.WontCompile ghcerr) = "Can't compile: " ++ (joinWith "\n" $ map Hint.errMsg ghcerr)+prettyPrintError (Hint.UnknownError errStr) = "Unknown Error: " ++ errStr+prettyPrintError (Hint.NotAllowed errStr) = "Not Allowed Action: " ++ errStr+prettyPrintError (Hint.GhcException errStr) = errStr+ -- PRIVATE FUNCTIONS ----------------------------------------------------------- modifyPage :: (Page -> Page) -> HPage () modifyPage f = get >>= (flip modifyPageNth) f . currentPage@@ -858,4 +862,3 @@ moduleElemDesc (Hint.Data dn dcs) = do mdcs <- flip mapM dcs $ moduleElemDesc . Hint.Fun return MEData{datName = dn, datCtors = mdcs}-
src/HPage/GUI/FreeTextWindow.hs view
@@ -28,7 +28,7 @@ import qualified HPage.Server as HPS import HPage.GUI.Dialogs import HPage.GUI.IDs-import Utils.Log+import HPage.Utils.Log import Paths_hpage -- cabal locations of data files
src/HPage/Server.hs view
@@ -8,7 +8,7 @@ import Control.Monad.Loops import Control.Concurrent.Process import HPage.Control-import Utils.Log+import HPage.Utils.Log newtype ServerHandle = SH {handle :: Handle (Either Stop (HPage ()))}
src/HPage/Test/Server.hs view
@@ -12,7 +12,7 @@ import System.Directory import Control.Monad.Loops import qualified Data.ByteString.Char8 as Str-import Utils.Log+import HPage.Utils.Log -- import Data.Set (fromList) instance Arbitrary Char where
+ src/HPage/Utils/Log.hs view
@@ -0,0 +1,38 @@++module HPage.Utils.Log where++import Control.Monad.Trans++data LogLevel = Trace | Debug | Info | Warning | Error | Fatal+ deriving (Show, Eq)++logIO :: Show a => LogLevel -> a -> IO ()+logIO lvl msg = putStrLn $ (show lvl) ++ ": " ++ (show msg)++liftLogIO :: (MonadIO m, Show a) => LogLevel -> a -> m ()+liftLogIO lvl = liftIO . (logIO lvl) ++traceIO, debugIO, infoIO, warnIO, errorIO, fatalIO :: Show a => a -> IO ()+liftTraceIO, liftDebugIO, liftInfoIO, liftWarnIO, liftErrorIO, liftFatalIO :: (MonadIO m, Show a) => a -> m ()++traceIO = logIO Trace+debugIO = logIO Debug+{- without log...+traceIO _ = return ()+debugIO _ = return ()+-}+infoIO = logIO Info+warnIO = logIO Warning+errorIO = logIO Error+fatalIO = logIO Fatal++{- with log...+liftTraceIO = liftLogIO Trace+-}+liftTraceIO _ = return ()+liftDebugIO = liftLogIO Debug+liftInfoIO = liftLogIO Info+liftWarnIO = liftLogIO Warning+-- liftErrorIO = liftLogIO Error+liftErrorIO _ = return ()+liftFatalIO = liftLogIO Fatal
− src/Language/Haskell/Interpreter/Server.hs
@@ -1,53 +0,0 @@--module Language.Haskell.Interpreter.Server (- start, stop, runIn, asyncRunIn, flush, ServerHandle- ) where--import Control.Concurrent.MVar-import Control.Monad.Error-import Control.Monad.Loops-import Control.Concurrent.Process-import Language.Haskell.Interpreter--newtype ServerHandle = SH {handle :: Handle (Either Stop (InterpreterT IO ()))}--data Stop = Stop--instance MonadInterpreter m => MonadInterpreter (ReceiverT r m) where- fromSession = lift . fromSession- modifySessionRef a = lift . (modifySessionRef a)- runGhc = lift . runGhc --start :: IO ServerHandle-start = (spawn $ makeProcess runInterpreter interpreter) >>= return . SH- where interpreter =- do- setImports ["Prelude"]- iterateWhile id $ do- v <- recv- case v of- Left Stop ->- return False- Right acc ->- lift acc >> return True--asyncRunIn :: ServerHandle -> InterpreterT IO a -> IO (MVar (Either InterpreterError a))-asyncRunIn server action = do- resVar <- liftIO newEmptyMVar- sendTo (handle server) $ Right $ try action >>= liftIO . putMVar resVar- return resVar--runIn :: ServerHandle -> InterpreterT IO a -> IO (Either InterpreterError a)-runIn server action = runHere $ do- me <- self- sendTo (handle server) $ Right $ try action >>= sendTo me- recv--flush :: ServerHandle -> IO (Either InterpreterError ())-flush server = runIn server $ return ()--try :: InterpreterT IO b -> InterpreterT IO (Either InterpreterError b)-try a = (a >>= return . Right) `catchError` (return . Left)--stop :: ServerHandle -> IO ()-stop server = sendTo (handle server) $ Left Stop
− src/Language/Haskell/Interpreter/Utils.hs
@@ -1,14 +0,0 @@--module Language.Haskell.Interpreter.Utils (prettyPrintError) where--import Language.Haskell.Interpreter--prettyPrintError :: InterpreterError -> String-prettyPrintError (WontCompile ghcerr) = "Can't compile: " ++ (joinWith "\n" $ map errMsg ghcerr)-prettyPrintError (UnknownError errStr) = "Unknown Error: " ++ errStr-prettyPrintError (NotAllowed errStr) = "Not Allowed Action: " ++ errStr-prettyPrintError (GhcException errStr) = errStr--joinWith :: [a] -> [[a]] -> [a]-joinWith _ [] = []-joinWith sep (x:xs) = x ++ (concat . map (sep ++) $ xs)
− src/Utils/Log.hs
@@ -1,38 +0,0 @@--module Utils.Log where--import Control.Monad.Trans--data LogLevel = Trace | Debug | Info | Warning | Error | Fatal- deriving (Show, Eq)--logIO :: Show a => LogLevel -> a -> IO ()-logIO lvl msg = putStrLn $ (show lvl) ++ ": " ++ (show msg)--liftLogIO :: (MonadIO m, Show a) => LogLevel -> a -> m ()-liftLogIO lvl = liftIO . (logIO lvl) --traceIO, debugIO, infoIO, warnIO, errorIO, fatalIO :: Show a => a -> IO ()-liftTraceIO, liftDebugIO, liftInfoIO, liftWarnIO, liftErrorIO, liftFatalIO :: (MonadIO m, Show a) => a -> m ()--traceIO = logIO Trace-debugIO = logIO Debug-{- without log...-traceIO _ = return ()-debugIO _ = return ()--}-infoIO = logIO Info-warnIO = logIO Warning-errorIO = logIO Error-fatalIO = logIO Fatal--{- with log...-liftTraceIO = liftLogIO Trace--}-liftTraceIO _ = return ()-liftDebugIO = liftLogIO Debug-liftInfoIO = liftLogIO Info-liftWarnIO = liftLogIO Warning--- liftErrorIO = liftLogIO Error-liftErrorIO _ = return ()-liftFatalIO = liftLogIO Fatal