Merge pull request #193 from PierreR/master

Fix #192: compilation failure with classy-prelude 0.8

src/IHaskell/Eval/Completion.hs

@@ -11,7 +11,7 @@ This has a limited amount of context sensitivity. It distinguishes between four
 -}
 module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where
 
-import ClassyPrelude hiding (liftIO)
+import ClassyPrelude hiding (init, last, head, liftIO)
 --import Prelude
 
 import Control.Applicative ((<$>))
@@ -50,7 +50,7 @@ data CompletionType
      | Qualified String String
      | ModuleName String String
      | HsFilePath String String
-     | FilePath   String String 
+     | FilePath   String String
      | KernelOption String
      | Extension String
      deriving (Show, Eq)
@@ -70,7 +70,7 @@ complete line pos = do
 
   let target = completionTarget line pos
 
-  let matchedText = case completionType line pos target of 
+  let matchedText = case completionType line pos target of
         HsFilePath _ match ->  match
         FilePath   _ match ->  match
         otherwise       -> intercalate "." target
@@ -104,8 +104,8 @@ complete line pos = do
                 kernelOptNames = concatMap getSetName kernelOpts
                 otherNames = ["-package","-Wall","-w"]
 
-                fNames = map extName fFlags ++ 
-                         map extName fWarningFlags ++ 
+                fNames = map extName fFlags ++
+                         map extName fWarningFlags ++
                          map extName fLangFlags
                 fNoNames = map ("no"++) fNames
                 fAllNames = map ("-f"++) (fNames ++ fNoNames)
@@ -189,7 +189,7 @@ completionType line loc target
         isModName = all isCapitalized (init target)
         isCapitalized = isUpper . head
         lineUpToCursor = take loc line
-        fileComplete filePath = case parseShell lineUpToCursor of 
+        fileComplete filePath = case parseShell lineUpToCursor of
           Right xs -> filePath lineUpToCursor $
                        if endswith (last xs) lineUpToCursor
                        then last xs
@@ -212,7 +212,7 @@ completionTarget code cursor = expandCompletionPiece pieceToComplete
       delimPolicy = Drop
     }
 
-    isDelim :: Char -> Int -> Bool 
+    isDelim :: Char -> Int -> Bool
     isDelim char idx = char `elem` neverIdent  || isSymbol char
 
     splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]]
@@ -286,4 +286,4 @@ completePathFilter includeFile includeDirectory left right = liftIO $ do
       visible = filter (not . isHidden) suggestions
       hidden  = filter isHidden suggestions
   return $ visible ++ hidden
-  
+

src/IHaskell/Eval/Evaluate.hs

@@ -9,7 +9,7 @@ module IHaskell.Eval.Evaluate (
   interpret, evaluate, Interpreter, liftIO, typeCleaner, globalImports
   ) where
 
-import ClassyPrelude hiding (liftIO, hGetContents, try)
+import ClassyPrelude hiding (init, last, liftIO, head, hGetContents, tail, try)
 import Control.Concurrent (forkIO, threadDelay)
 import Prelude (putChar, head, tail, last, init, (!!))
 import Data.List.Utils
@@ -118,7 +118,7 @@ interpret allowedStdin action = runGhc (Just libdir) $ do
   sandboxPackages <- liftIO getSandboxPackageConf
   let pkgConfs = case sandboxPackages of
         Nothing -> extraPkgConfs dflags
-        Just path -> 
+        Just path ->
           let pkg  = PkgConfFile path in
             (pkg:) . extraPkgConfs dflags
 
@@ -274,19 +274,19 @@ safely state = ghandle handler . ghandle sourceErrorHandler
     sourceErrorHandler srcerr = do
       let msgs = bagToList $ srcErrorMessages srcerr
       errStrs <- forM msgs $ \msg -> do
-        shortStr <- doc $ errMsgShortDoc msg 
-        contextStr <- doc $ errMsgExtraInfo msg 
+        shortStr <- doc $ errMsgShortDoc msg
+        contextStr <- doc $ errMsgExtraInfo msg
         return $ unlines [shortStr, contextStr]
 
       let fullErr = unlines errStrs
-      
+
       return EvalOut {
         evalStatus = Failure,
         evalResult = displayError fullErr,
         evalState = state,
         evalPager = ""
       }
-      
+
 doc :: GhcMonad m => SDoc -> m String
 doc sdoc = do
   flags <- getSessionDynFlags
@@ -301,7 +301,7 @@ doc sdoc = do
     string_txt (Pretty.Str s1)  s2 = s1 ++ s2
     string_txt (Pretty.PStr s1) s2 = unpackFS s1 ++ s2
     string_txt (Pretty.LStr s1 _) s2 = unpackLitString s1 ++ s2
-    
+
 
 wrapExecution :: KernelState
               -> Interpreter Display
@@ -332,7 +332,7 @@ setDynFlags ext = do
 
     -- Create the parse errors.
     let noParseErrs = map (("Could not parse: " ++) . unLoc) unrecognized
-        allWarns = map unLoc warnings ++ 
+        allWarns = map unLoc warnings ++
                      ["-package not supported yet" | packageFlags flags /= packageFlags flags']
         warnErrs    = map ("Warning: " ++) allWarns
     return $ noParseErrs ++ warnErrs
@@ -395,8 +395,8 @@ evalCommand _ (Module contents) state = wrapExecution state $ do
     -- Since nothing prevents loading the module, compile and load it.
     Nothing -> doLoadModule modName modName
 
--- | Directives set via `:set`. 
-evalCommand output (Directive SetDynFlag flags) state = 
+-- | Directives set via `:set`.
+evalCommand output (Directive SetDynFlag flags) state =
   case words flags of
     -- For a single flag.
     [flag] -> do
@@ -633,7 +633,7 @@ evalCommand _ (Directive GetInfo str) state = safely state $ do
       htmlify str =
         printf "<div style='background: rgb(247, 247, 247);'><form><textarea id='code'>%s</textarea></form></div>" str
         ++ script
-      script = 
+      script =
         "<script>CodeMirror.fromTextArea(document.getElementById('code'), {mode: 'haskell', readOnly: 'nocursor'});</script>"
 
   return EvalOut {
@@ -686,7 +686,7 @@ evalCommand output (Statement stmt) state = wrapExecution state $ do
 
           -- Return plain and html versions.
           -- Previously there was only a plain version.
-          text -> Display 
+          text -> Display
             [plain $ joined ++ "\n" ++ text,
              html  $ htmled ++ mono text]
 
@@ -730,7 +730,7 @@ evalCommand output (Expression expr) state = do
     -- Check if the error is due to trying to print something that doesn't
     -- implement the Show typeclass.
     isShowError (ManyDisplay _) = False
-    isShowError (Display errs) = 
+    isShowError (Display errs) =
         -- Note that we rely on this error message being 'type cleaned', so
         -- that `Show` is not displayed as GHC.Show.Show.
         startswith "No instance for (Show" msg &&
@@ -842,7 +842,7 @@ hoogleResults state results = EvalOut {
     evalPager = output
   }
   where
-    fmt = 
+    fmt =
         case getFrontend state of
           IPythonNotebook -> Hoogle.HTML
           IPythonConsole -> Hoogle.Plain

src/IHaskell/Eval/Hoogle.hs

 {-# LANGUAGE NoImplicitPrelude, FlexibleInstances, OverloadedStrings #-}
-module IHaskell.Eval.Hoogle ( 
+module IHaskell.Eval.Hoogle (
   search,
   document,
   render,
@@ -7,7 +7,7 @@ module IHaskell.Eval.Hoogle (
   HoogleResult
   ) where
 
-import ClassyPrelude hiding (span, div)
+import ClassyPrelude hiding (last, span, div)
 import Text.Printf
 import Network.HTTP
 import Data.Aeson
@@ -93,7 +93,7 @@ document string = do
     [] -> [NoResult "no matching identifiers found."]
     res -> res
   where
-    matches (SearchResult resp) = 
+    matches (SearchResult resp) =
       case split " " $ self resp of
         name:_ -> strip string == strip name
         _ -> False
@@ -109,33 +109,33 @@ render HTML  = renderHtml
 -- | Render a Hoogle result to plain text.
 renderPlain :: HoogleResult -> String
 
-renderPlain (NoResult res) = 
+renderPlain (NoResult res) =
   "No response available: " ++ res
 
-renderPlain (SearchResult resp) = 
-  printf "%s\nURL: %s\n%s" 
+renderPlain (SearchResult resp) =
+  printf "%s\nURL: %s\n%s"
   (self resp)
   (location resp)
   (docs resp)
 
-renderPlain (DocResult resp) = 
-  printf "%s\nURL: %s\n%s" 
+renderPlain (DocResult resp) =
+  printf "%s\nURL: %s\n%s"
   (self resp)
   (location resp)
   (docs resp)
 
 -- | Render a Hoogle result to HTML.
 renderHtml :: HoogleResult -> String
-renderHtml (NoResult resp) = 
+renderHtml (NoResult resp) =
   printf "<span class='err-msg'>No result: %s</span>" resp
 
-renderHtml (DocResult resp) = 
-  renderSelf (self resp) (location resp) 
+renderHtml (DocResult resp) =
+  renderSelf (self resp) (location resp)
   ++
   renderDocs (docs resp)
 
 renderHtml (SearchResult resp) =
-  renderSelf (self resp) (location resp) 
+  renderSelf (self resp) (location resp)
   ++
   renderDocs (docs resp)
 
@@ -156,17 +156,17 @@ renderSelf string loc
         span "hoogle-class" (link loc $ extractClass string) ++
         packageSub package
 
-  | otherwise 
+  | otherwise
     = let [name, args] = split "::" string
           package = extractPackageName loc
           modname = extractModuleName loc in
-        span "hoogle-name" (unicodeReplace $ 
+        span "hoogle-name" (unicodeReplace $
           link loc (strip name) ++
           " :: " ++
           strip args)
         ++ packageAndModuleSub package modname
 
-  where 
+  where
     extractPackage = strip . replace "package" ""
     extractModule = strip . replace "module" ""
     extractClass = strip . replace "class" ""
@@ -176,28 +176,28 @@ renderSelf string loc
 
     unicodeReplace :: String -> String
     unicodeReplace =
-     replace "forall" "&#x2200;" . 
-     replace "=>"     "&#x21D2;" . 
-     replace "->"     "&#x2192;" . 
+     replace "forall" "&#x2200;" .
+     replace "=>"     "&#x21D2;" .
+     replace "->"     "&#x2192;" .
      replace "::"     "&#x2237;"
 
     packageSub Nothing = ""
     packageSub (Just package) =
-      span "hoogle-sub" $ 
+      span "hoogle-sub" $
         "(" ++ pkg ++ " " ++ span "hoogle-package" package ++ ")"
 
     packageAndModuleSub Nothing _ = ""
     packageAndModuleSub (Just package) Nothing = packageSub (Just package)
     packageAndModuleSub (Just package) (Just modname) =
-        span "hoogle-sub" $ 
-          "(" ++ pkg ++ " " ++ span "hoogle-package" package ++ 
+        span "hoogle-sub" $
+          "(" ++ pkg ++ " " ++ span "hoogle-package" package ++
            ", " ++ mod ++ " " ++ span "hoogle-module" modname ++ ")"
 
 renderDocs :: String -> String
-renderDocs doc = 
+renderDocs doc =
   let groups = groupBy bothAreCode $ lines doc
       nonull = filter (not . null . strip)
-      bothAreCode s1 s2 = 
+      bothAreCode s1 s2 =
         startswith ">" (strip s1) &&
         startswith ">" (strip s2)
       isCode (s:_) = startswith ">" $ strip s

src/IHaskell/Eval/Parser.hs

@@ -15,7 +15,7 @@ module IHaskell.Eval.Parser (
     ) where
 
 -- Hide 'unlines' to use our own 'joinLines' instead.
-import ClassyPrelude hiding (liftIO, unlines)
+import ClassyPrelude hiding (head, tail, liftIO, unlines)
 
 import Data.List (findIndex, maximumBy, maximum, inits)
 import Data.String.Utils (startswith, strip, split)
@@ -112,7 +112,7 @@ parseString codeString = do
 
 activateParsingExtensions :: GhcMonad m => CodeBlock -> m ()
 activateParsingExtensions (Directive SetExtension ext) = void $ setExtension ext
-activateParsingExtensions (Directive SetDynFlag flags) = 
+activateParsingExtensions (Directive SetDynFlag flags) =
   case stripPrefix "-X" flags of
     Just ext -> void $ setExtension ext
     Nothing -> return ()
@@ -201,10 +201,10 @@ joinFunctions (Located line (Declaration decl) : rest) =
     -- Get all declarations with the same name as the first declaration.
     -- The name of a declaration is the first word, which we expect to be
     -- the name of the function.
-    havingSameName :: [Located CodeBlock] -> ([Located CodeBlock], [Located CodeBlock]) 
+    havingSameName :: [Located CodeBlock] -> ([Located CodeBlock], [Located CodeBlock])
     havingSameName blocks =
       let name = head $ words decl
-          sameName = takeWhile (isNamedDecl name) rest 
+          sameName = takeWhile (isNamedDecl name) rest
           others = drop (length sameName) rest in
         (Located line (Declaration decl) : sameName, others)
 
@@ -216,8 +216,8 @@ joinFunctions (Located line (Declaration decl) : rest) =
 -- declarations. Parse the declaration joining separately.
 joinFunctions (Located line (TypeSignature sig) : Located dl (Declaration decl) : rest) =
   Located line (Declaration $ sig ++ "\n" ++ joinedDecl):remaining
-  where Located _ (Declaration joinedDecl):remaining = joinFunctions $ Located dl (Declaration decl) : rest 
-        
+  where Located _ (Declaration joinedDecl):remaining = joinFunctions $ Located dl (Declaration decl) : rest
+
 joinFunctions (x:xs) = x : joinFunctions xs
 joinFunctions [] = []
 
@@ -232,7 +232,7 @@ parseDirective (':':directive) line = case find rightDirective directives of
   Just (directiveType, _) -> Directive directiveType arg
     where arg = unwords restLine
           _:restLine = words directive
-  Nothing -> 
+  Nothing ->
     let directiveStart = case words directive of
           [] -> ""
           first:_ -> first in
@@ -264,7 +264,7 @@ getModuleName moduleSrc = do
   let output = runParser flags parserModule moduleSrc
   case output of
     Failure {} -> error "Module parsing failed."
-    Parsed mod -> 
+    Parsed mod ->
       case unLoc <$> hsmodName (unLoc mod) of
         Nothing -> error "Module must have a name."
         Just name -> return $ split "." $ moduleNameString name

src/Main.hs

 {-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, ScopedTypeVariables #-}
 -- | Description : Argument parsing and basic messaging loop, using Haskell
---                 Chans to communicate with the ZeroMQ sockets. 
+--                 Chans to communicate with the ZeroMQ sockets.
 module Main where
 
 -- Prelude imports.
-import ClassyPrelude  hiding (liftIO)
+import ClassyPrelude  hiding (last, liftIO)
 import Prelude        (last, read)
 
 -- Standard library imports.
@@ -45,7 +45,7 @@ main ::  IO ()
 main = do
   args <- parseFlags <$> map unpack <$> getArgs
   case args of
-    Left errorMessage -> 
+    Left errorMessage ->
       hPutStrLn stderr errorMessage
     Right args ->
       ihaskell args
@@ -57,9 +57,9 @@ chooseIPython (_:xs) = chooseIPython xs
 
 ihaskell :: Args -> IO ()
 -- If no mode is specified, print help text.
-ihaskell (Args (ShowHelp help) _) = 
+ihaskell (Args (ShowHelp help) _) =
   putStrLn $ pack help
-    
+
 ihaskell (Args Console flags) = showingHelp Console flags $ do
   ipython <- chooseIPython flags
   setupIPython ipython
@@ -113,7 +113,7 @@ showingHelp mode flags act =
       putStrLn $ pack $ help mode
     Nothing ->
       act
- 
+
 -- | Parse initialization information from the flags.
 initInfo :: FrontendType -> [Argument] -> IO InitInfo
 initInfo front [] = return InitInfo { extensions = [], initCells = [], initDir = ".", frontend = front }
@@ -155,11 +155,11 @@ runKernel profileSrc initInfo = do
     -- reason (completely unknown to me).
     liftIO ignoreCtrlC
 
-    -- Initialize the context by evaluating everything we got from the  
+    -- Initialize the context by evaluating everything we got from the
     -- command line flags. This includes enabling some extensions and also
     -- running some code.
     let extLines = map (":extension " ++) $ extensions initInfo
-        noPublish _ = return ()       
+        noPublish _ = return ()
         evaluator line = do
           -- Create a new state each time.
           stateVar <- liftIO initialKernelState
@@ -178,7 +178,7 @@ runKernel profileSrc initInfo = do
 
       -- Create the reply, possibly modifying kernel state.
       oldState <- liftIO $ takeMVar state
-      (newState, reply) <- replyTo interface request replyHeader oldState 
+      (newState, reply) <- replyTo interface request replyHeader oldState
       liftIO $ putMVar state newState
 
       -- Write the reply to the reply channel.
@@ -217,7 +217,7 @@ createReplyHeader parent = do
     msgType = repType
   }
 
--- | Compute a reply to a message. 
+-- | Compute a reply to a message.
 replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message)
 
 -- Reply to kernel info requests with a kernel info reply. No computation
@@ -333,9 +333,9 @@ replyTo _ ObjectInfoRequest{objectName=oname} replyHeader state = do
   docs <- info $ Chars.unpack oname
   let reply = ObjectInfoReply {
                 header = replyHeader,
-                objectName = oname, 
+                objectName = oname,
                 objectFound = strip docs /= "",
                 objectTypeString = Chars.pack docs,
-                objectDocString  = Chars.pack docs                    
+                objectDocString  = Chars.pack docs
               }
   return (state, reply)