scion-browser 0.2.17 → 0.2.18

raw patch · 4 files changed

+37/−23 lines, 4 filesdep ~haskell-src-exts

Dependency ranges changed: haskell-src-exts

Files

• scion-browser.cabal +3/−3
• src/Main.hs +21/−14
• src/Scion/PersistentBrowser/Parser/Internal.hs +6/−2
• src/Server/PersistentCommands.hs +7/−4

@@ -1,5 +1,5 @@ name:           scion-browser
-version:        0.2.17+version:        0.2.18 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3
@@ -25,7 +25,7 @@     text == 0.11.*,
     parsec >= 3 && < 4,
     Cabal >= 0.10,
-    haskell-src-exts >= 1.11 && < 2,
+    haskell-src-exts >= 1.11 && < 1.15,
     process >= 1 && < 2,
     tar >= 0.3 && < 0.5,
     zlib == 0.5.*,
@@ -105,7 +105,7 @@     text == 0.11.*,     parsec >= 3 && < 4,     Cabal >= 0.10,-    haskell-src-exts >= 1.11 && < 2,+    haskell-src-exts >= 1.11 && < 1.15,     process >= 1 && < 2,     tar >= 0.3 && < 0.5,     zlib == 0.5.*,

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
@@ -18,33 +18,40 @@ import Scion.PersistentBrowser.Util (logToStdout)
 
 import GHC.IO.Handle (hDuplicate,hDuplicateTo)
+ 
 main :: IO ()
 main = do args <- getArgs 
           case args of
-            ("--version":_) -> putStrLn ("scion-browser executable, version " ++ (showVersion version))
-            _               -> do runStateT (runInputT defaultSettings loop) initialState
-                                  return ()
+            ("--version":_) -> putStrLn ("scion-browser executable, version " ++ showVersion version)
+            ("--clear":_)     -> run False
+            _               -> run True
+            
+run :: Bool -> IO()       
+run doCompression=do
+        runStateT (runInputT defaultSettings (loop doCompression)) initialState
+        return ()
 
-loop :: InputT BrowserM ()
-loop = do 
+loop :: Bool -> InputT BrowserM ()
+loop doCompression = do 
           maybeLine <- getInputLine ""
           case maybeLine of
             Nothing -> return () -- ctrl+D or EOF
-            Just line -> do
-              case Atto.parse json (BSU.fromString line) of
-                Atto.Fail _ _ e   -> (liftIO $ logToStdout ("error in command: " ++ e)) >> loop
-                Atto.Partial _   -> (liftIO $ logToStdout ("incomplete data error in command: ")) >> loop
-                Atto.Done _ value -> case T.parse parseJSON value of
-                                       Error e     -> (liftIO $ logToStdout ("error in command: " ++ e)) >> loop
+            Just line -> 
+              case Atto.parseOnly json (BSU.fromString line) of
+                Left e   -> liftIO (logToStdout ("error in command: " ++ e)) >> loop doCompression
+                Right value -> case T.parse parseJSON value of
+                                       Error e     -> liftIO (logToStdout ("error in command: " ++ e)) >> loop doCompression
                                        Success cmd -> do 
                                                          stdout_excl <- liftIO $ hDuplicate stdout
                                                          liftIO $ hDuplicateTo stderr stdout  -- redirect stdout to stderr
                                                          (res, continue) <- lift $ executeCommand cmd
                                                          liftIO $ hDuplicateTo stdout_excl stdout  -- redirect stdout to original stdout
                                                          let encoded    = LBS.append (encode res) "\n"
-                                                             compressed = Zlib.compressWith Zlib.defaultCompressParams { Zlib.compressLevel = Zlib.bestSpeed } encoded
+                                                             compressed = if doCompression 
+                                                                then Zlib.compressWith Zlib.defaultCompressParams { Zlib.compressLevel = Zlib.bestSpeed } encoded
+                                                                else encoded
                                                          liftIO $ LBS.putStr compressed
                                                          liftIO $ hFlush stdout
-                                                         if continue then loop else return ()
+                                                         when continue $ loop doCompression
 

@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes,CPP #-}
 module Scion.PersistentBrowser.Parser.Internal where
 
 -- import Debug.Trace (trace)
@@ -17,7 +17,7 @@ import Text.Parsec.String as BS
 import Text.Parsec.Char
 import Text.Parsec.Combinator
-import Text.Parsec.Prim
+import Text.Parsec.Prim 
 type BSParser a = forall st. BS.GenParser Char st a
 
@@ -114,7 +114,11 @@ lonelyComment = try (docComment >> return [])
 
 parseTypeMode :: Parser.ParseMode
+#if MIN_VERSION_haskell_src_exts(1,14,0)  
+parseTypeMode = Parser.ParseMode "" Haskell98 knownExtensions False False Nothing
+#else
 parseTypeMode = Parser.ParseMode "" knownExtensions False False Nothing
+#endif
 
 parseType :: String -> BSParser (Documented Type)
 parseType st = return (parseType' st)

@@ -101,7 +101,7 @@         then do modify (\s -> s { localDb = Just path })
                 lift $ logToStdout "Local database loaded"
         else modify (\s -> s { localDb = Nothing })
-     return (String "ok", True)   
+     return (ok, True)   
 executeCommand (LoadHackageDatabase path rebuild) =
   do fileExists <- lift $ doesFileExist path
      let fileExists' = fileExists `seq` fileExists
@@ -116,7 +116,7 @@         then do modify (\s -> s { hackageDb = Just path })
                 lift $ logToStdout "Hackage database loaded"
         else modify (\s -> s { hackageDb = Nothing })
-     return (String "ok", True)   
+     return (ok, True)   
 executeCommand (GetPackages cdb)         = do pkgs <- runDb cdb allPackages
                                               return (nubJSON pkgs, True)
 executeCommand (GetModules cdb mname)  = 
@@ -139,11 +139,14 @@                                               ret <- lift $ H.checkDatabase extraH
                                               return (String $ T.pack $ show ret, True)
 executeCommand (SetExtraHooglePath p)    = do modify (\s -> s { extraHooglePath = Just p })
-                                              return (String "ok", True)
+                                              return (ok, True)
 executeCommand (GetDeclarationModules cdb d) = 
                                            do mods <- runDb cdb (\_ -> getModulesWhereDeclarationIs d)
                                               return (toJSON mods, True)
-executeCommand Quit                      = return (String "ok", False)
+executeCommand Quit                      = return (ok, False)
+
+ok :: Value
+ok = String "ok"
 
 nubJSON :: (ToJSON a)=> [a] -> Value
 nubJSON = Array . fromList . nub . map toJSON