leksah-server 0.15.0.5 → 0.15.0.6

raw patch · 13 files changed

+195/−224 lines, 13 filesdep ~leksah-serverPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: leksah-server

API changes (from Hackage documentation)

Files

• leksah-server.cabal +2/−2
• src/IDE/Core/CTypes.hs +12/−13
• src/IDE/Core/Serializable.hs +11/−24
• src/IDE/HeaderParser.hs +2/−2
• src/IDE/Metainfo/Collector.hs +1/−1
• src/IDE/Metainfo/InterfaceCollector.hs +19/−22
• src/IDE/Metainfo/PackageCollector.hs +5/−11
• src/IDE/Metainfo/SourceCollectorH.hs +40/−39
• src/IDE/Metainfo/SourceDB.hs +12/−13
• src/IDE/Utils/FileUtils.hs +41/−49
• src/IDE/Utils/GHCUtils.hs +8/−8
• src/IDE/Utils/Tool.hs +41/−39
• src/IDE/Utils/VersionUtils.hs +1/−1

@@ -1,5 +1,5 @@ name: leksah-server-version: 0.15.0.5+version: 0.15.0.6 cabal-version: >= 1.10.2 build-type: Simple license: GPL@@ -195,7 +195,7 @@     hs-source-dirs: tests     main-is:    TestTool.hs     build-depends: base >= 4.0.0.0 && <4.9,  hslogger >= 1.0.7 && <1.3,-               leksah-server == 0.15.0.5,+               leksah-server == 0.15.0.6,                HUnit >=1.2 && <1.3, transformers >=0.2.2.0 && <0.5, conduit >= 1.0.8 && <1.3,                conduit-extra >=1.0.0.1 && <1.2, resourcet 

@@ -71,6 +71,7 @@ import Data.Typeable (Typeable) import Data.Map (Map) import Data.Set (Set)+import Data.Maybe (fromMaybe) import Default (Default(..)) import MyMissing (nonEmptyLines) #if MIN_VERSION_ghc(7,6,0)@@ -172,9 +173,7 @@     symUnion        :: alpha -> alpha -> alpha  instance SymbolTable (Map Text [Descr]) where-    symLookup str smap  = case str `Map.lookup` smap of-                                Just dl -> dl-                                Nothing -> []+    symLookup str smap  = fromMaybe [] (str `Map.lookup` smap)     symbols             = Map.keysSet     symSplitLookup      = Map.splitLookup     symInsert           = Map.insertWith (++)@@ -184,7 +183,7 @@  data PackageDescr       =   PackageDescr {         pdPackage           ::   PackageIdentifier-    ,   pdMbSourcePath      ::   (Maybe FilePath)+    ,   pdMbSourcePath      ::   Maybe FilePath     ,   pdModules           ::   [ModuleDescr]     ,   pdBuildDepends      ::   [PackageIdentifier] } deriving (Show,Typeable)@@ -205,8 +204,8 @@  data ModuleDescr        =   ModuleDescr {         mdModuleId          ::   PackModule-    ,   mdMbSourcePath      ::   (Maybe FilePath)                  -- unqualified-    ,   mdReferences        ::   (Map ModuleName (Set Text)) -- imports+    ,   mdMbSourcePath      ::   Maybe FilePath                  -- unqualified+    ,   mdReferences        ::   Map ModuleName (Set Text) -- imports     ,   mdIdDescriptions    ::   [Descr] } deriving (Show,Typeable) @@ -339,13 +338,13 @@                                     .  showString (display (modu pd))  parsePackModule         ::   Text -> PackModule-parsePackModule str     =   let (pack',mod') = T.span (\c -> c /= ':') str-                            in case packageIdentifierFromString $ pack' of+parsePackModule str     =   let (pack',mod') = T.span (/= ':') str+                            in case packageIdentifierFromString pack' of                                 Nothing -> perror . T.unpack $ "Types>>parsePackModule: Can't parse package:" <> str                                 Just pi'-> case simpleParse . T.unpack $ T.tail mod' of                                             Nothing -> perror . T.unpack $                                                 "Types>>parsePackModule: Can't parse module:" <> str-                                            Just mn -> (PM pi' mn)+                                            Just mn -> PM pi' mn     where perror s      =   error $ "cannot parse PackModule from " ++ s  showPackModule :: PackModule -> Text@@ -394,9 +393,9 @@     getDefault = parsePackModule "unknow-0:Undefined"  instance Default PackageIdentifier where-    getDefault = case packageIdentifierFromString "unknown-0" of-                    Nothing -> error "CTypes.getDefault: Can't parse Package Identifier"-                    Just it -> it+    getDefault = fromMaybe+                   (error "CTypes.getDefault: Can't parse Package Identifier")+                   (packageIdentifierFromString "unknown-0")  -- | A portion of the source, spanning one or more lines and zero or more columns. data SrcSpan = SrcSpan@@ -494,7 +493,7 @@     pretty (IAbs name)                = pretty name     pretty (IThingAll name)           = pretty name <> text "(..)"     pretty (IThingWith name nameList) =-        pretty name <> (parenList (map (pretty.VName) nameList))+        pretty name <> parenList (map (pretty . VName) nameList)  instance Pretty VName  where     pretty (VName t) = let str = T.unpack t in if isOperator str then PP.parens (PP.text str) else PP.text str

@@ -1,10 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC-    -XScopedTypeVariables-    -XStandaloneDeriving-    -XDeriveDataTypeable-    -fno-warn-orphans #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  ----------------------------------------------------------------------------- --@@ -38,15 +34,7 @@ import IDE.Core.CTypes import Data.Text (Text) import qualified Data.Text as T (pack, unpack)-#if !MIN_VERSION_ghc(7,7,0)-import Data.Typeable (Typeable)-#endif -#if !MIN_VERSION_ghc(7,7,0)-deriving instance Typeable PackageIdentifier-deriving instance Typeable ModuleName-deriving instance Typeable PackageName-#endif -----------------------------------------------------------  instance BinaryShared Text where@@ -56,9 +44,8 @@     getShared x = T.pack <$> getShared (T.unpack <$> x)  instance BinaryShared PackModule where-    put =   putShared (\ (PM pack' modu') -> do-                (put pack')-                (put modu'))+    put =   putShared (\ (PM pack' modu') -> do put pack'+                                                put modu')     get =   getShared (do                 pack'                <- get                 modu'                <- get@@ -147,7 +134,7 @@  instance BinaryShared TypeDescr where     put VariableDescr-        = do    put (1:: Int)+        =       put (1:: Int)     put (FieldDescr typeDescrF')         = do    put (2:: Int)                 put typeDescrF'@@ -159,7 +146,7 @@                 put constructors'                 put fields'     put TypeDescr-        = do    put (5:: Int)+        =       put (5:: Int)     put (NewtypeDescr constructor' mbField')         = do    put (6:: Int)                 put constructor'@@ -175,15 +162,15 @@         = do    put (9:: Int)                 put binds'     put KeywordDescr-        = do    put (10:: Int)+        =       put (10:: Int)     put ExtensionDescr-        = do    put (11:: Int)+        =       put (11:: Int)     put ModNameDescr-        = do    put (12:: Int)+        =       put (12:: Int)     put QualModNameDescr-        = do    put (13:: Int)+        =       put (13:: Int)     put ErrorDescr-        = do    put (14:: Int)+        =       put (14:: Int)      get = do    (typeHint :: Int)                <- get                 case typeHint of

@@ -68,9 +68,9 @@         Left str                                      -> return (ServerFailed str)         Right (_, pr@HsModule{ hsmodImports = []})       -> do             let i = case hsmodDecls pr of-                        decls@(_hd:_tl) -> (foldl (\ a b -> min a (srcSpanStartLine' (getLoc b))) 0 decls) - 1+                        decls@(_hd:_tl) -> foldl (\ a b -> min a (srcSpanStartLine' (getLoc b))) 0 decls - 1                         [] -> case hsmodExports pr of-                            Just list ->  (foldl (\ a b -> max a (srcSpanEndLine' (getLoc b))) 0 (unLoc710 list)) + 1+                            Just list -> foldl (\ a b -> max a (srcSpanEndLine' (getLoc b))) 0 (unLoc710 list) + 1                             Nothing -> case hsmodName pr of                                         Nothing -> 0                                         Just mn -> srcSpanEndLine' (getLoc mn) + 2

@@ -50,7 +50,7 @@ import System.Log.Handler.Simple(fileHandler) import Network(withSocketsDo) import Network.Socket-       (inet_addr, SocketType(..), SockAddr(..), PortNumber(..))+       (inet_addr, SocketType(..), SockAddr(..)) import IDE.Utils.Server import System.IO (Handle, hPutStrLn, hGetLine, hFlush, hClose) import IDE.HeaderParser(parseTheHeader)

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -XScopedTypeVariables -XFlexibleContexts#-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Metainfo.InterfaceCollector@@ -117,7 +118,7 @@ #else                                  (mkPackageId pid) #endif-        isBase          =   pkgName pid == (PackageName "base")+        isBase          =   pkgName pid == PackageName "base"         ifaces          =   mapM (\ mn -> findAndReadIface empty                                           (if isBase                                                 then mkBaseModule_ mn@@ -126,7 +127,7 @@     hscEnv              <-  getSession     let gblEnv          =   IfGblEnv { if_rec_types = Nothing }     maybes              <-  Hs.liftIO $ initTcRnIf  'i' hscEnv gblEnv () ifaces-    let res             =   catMaybes (map handleErr maybes)+    let res             =   mapMaybe handleErr maybes     return res     where         handleErr (M.Succeeded val)   =   Just val@@ -137,9 +138,9 @@ extractInfo :: DynFlags -> [(ModIface, FilePath)] -> [(ModIface, FilePath)] -> PackageIdAndKey ->                     [PackageIdentifier] -> PackageDescr extractInfo dflags ifacesExp ifacesHid pid buildDepends =-    let allDescrs           =   concatMap (extractExportedDescrH dflags pid)-                                    (map fst (ifacesHid ++ ifacesExp))-        mods                =   map (extractExportedDescrR dflags pid allDescrs) (map fst ifacesExp)+    let allDescrs           =   concatMap (extractExportedDescrH dflags pid . fst)+                                  (ifacesHid ++ ifacesExp)+        mods                =   map (extractExportedDescrR dflags pid allDescrs . fst) ifacesExp     in PackageDescr {         pdPackage           =   packId pid     ,   pdModules           =   mods@@ -159,8 +160,7 @@                                     $ concatMap availNames                                         $ concatMap snd (mi_exports iface) #endif-        exportedDecls       =   filter (\ ifdecl -> (occNameString $ ifName ifdecl)-                                                    `Set.member` exportedNames)+        exportedDecls       =   filter (\ ifdecl -> occNameString (ifName ifdecl) `Set.member` exportedNames)                                                             (map snd (mi_decls iface))     in  concatMap (extractIdentifierDescr dflags pid [mid]) exportedDecls @@ -186,9 +186,9 @@                                                     `Set.member` exportedNames)                                                             (map snd (mi_decls iface))         ownDecls        =   concatMap (extractIdentifierDescr dflags pid [mid]) exportedDecls-        otherDecls      =   exportedNames `Set.difference` (Set.fromList (map dscName ownDecls))-        reexported      =   map (\d -> Reexported (ReexportedDescr (Just (PM (packId pid) mid)) d))-                                 $ filter (\k -> (dscName k) `Set.member` otherDecls) hidden+        otherDecls      =   exportedNames `Set.difference` Set.fromList (map dscName ownDecls)+        reexported      =   map (Reexported . ReexportedDescr (Just (PM (packId pid) mid)))+                                 $ filter (\k -> dscName k `Set.member` otherDecls) hidden         inst            =   concatMap (extractInstances dflags (PM (packId pid) mid)) (mi_insts iface)         uses            =   Map.fromList . catMaybes $ map (extractUsages dflags) (mi_usages iface)         declsWithExp    =   map withExp ownDecls@@ -259,7 +259,7 @@                             in [Real $ descr{dscTypeHint' = ClassDescr superclasses classOpsID}] #if MIN_VERSION_ghc(7,6,0)             (IfaceAxiom {})-                        ->  [Real $ descr]+                        ->  [Real descr] #endif #if MIN_VERSION_ghc(7,10,0)             (IfaceSynonym {})@@ -274,11 +274,11 @@ #endif #if MIN_VERSION_ghc(7,8,0)             (IfacePatSyn {})-                        ->  [Real $ descr]+                        ->  [Real descr] #endif  extractConstructors :: DynFlags -> OccName -> [IfaceConDecl] -> [SimpleDescr]-extractConstructors dflags name decls = map (\decl -> SimpleDescr (T.pack . unpackFS $occNameFS (ifConOcc decl))+extractConstructors dflags name = map (\decl -> SimpleDescr (T.pack . unpackFS $occNameFS (ifConOcc decl))                                                  (Just (BS.pack $ filterExtras $ showSDocUnqual dflags $ #if MIN_VERSION_ghc(7,10,0)                                                     pprIfaceForAllPart (ifConExTvs decl)@@ -286,7 +286,7 @@                                                     pprIfaceForAllPart (ifConUnivTvs decl ++ ifConExTvs decl) #endif                                                         (eq_ctxt decl ++ ifConCtxt decl) (pp_tau decl)))-                                                 Nothing Nothing True) decls+                                                 Nothing Nothing True)      where     pp_tau decl     = case map pprParendIfaceType (ifConArgTys decl) ++ [pp_res_ty decl] of@@ -323,7 +323,7 @@                                                 Nothing Nothing True  extractSuperClassNames :: [IfacePredType] -> [Text]-extractSuperClassNames l = catMaybes $ map extractSuperClassName l+extractSuperClassNames = mapMaybe extractSuperClassName     where #if !MIN_VERSION_ghc(7,3,0)             extractSuperClassName (IfaceClassP name _)  =@@ -341,18 +341,15 @@     -> [Descr] extractInstances dflags pm ifaceInst  =     let className   =   showSDocUnqual dflags $ ppr $ ifInstCls ifaceInst-        dataNames   =   map (\iftc -> T.pack . showSDocUnqual dflags $ ppr iftc)-                            $ map fromJust-                                $ filter isJust-                                    $ ifInstTys ifaceInst-    in [Real (RealDescr+        dataNames   =   map (T.pack . showSDocUnqual dflags . ppr) . catMaybes $ ifInstTys ifaceInst+    in [Real RealDescr                     {   dscName'         =   T.pack className                     ,   dscMbTypeStr'    =   Nothing                     ,   dscMbModu'       =   Just pm                     ,   dscMbLocation'   =   Nothing                     ,   dscMbComment'    =   Nothing                     ,   dscTypeHint'     =   InstanceDescr dataNames-                    ,   dscExported'     =   False})]+                    ,   dscExported'     =   False}]   extractUsages :: DynFlags -> Usage -> Maybe (ModuleName, Set Text)

@@ -29,11 +29,8 @@ import System.Log.Logger (errorM, debugM, infoM) import IDE.Metainfo.InterfaceCollector (collectPackageFromHI) import IDE.Core.CTypes-       (getThisPackage, SimpleDescr(..), TypeDescr(..),-        ReexportedDescr(..), Descr(..), RealDescr(..), dscTypeHint,-        descrType, dscName, Descr, ModuleDescr(..), PackModule(..),-        PackageDescr(..), metadataVersion, leksahVersion,-        packageIdentifierToString, packId)+       (metadataVersion, PackageDescr(..), leksahVersion, getThisPackage,+        PackageIdAndKey(..), packageIdentifierToString) import IDE.Utils.FileUtils (getCollectorPath) import System.Directory (doesDirectoryExist, setCurrentDirectory) import IDE.Utils.Utils@@ -41,9 +38,6 @@         leksahMetadataSystemFileExtension) import System.FilePath (dropFileName, takeBaseName, (<.>), (</>)) import Data.Binary.Shared (encodeFileSer)-import qualified Data.Map as Map-       (fromListWith, fromList, keys, lookup)-import Data.List (delete, nub) import Distribution.Text (display) import Control.Monad.IO.Class (MonadIO, MonadIO(..)) import qualified Control.Exception as E (SomeException, catch)@@ -133,7 +127,7 @@     where         retrieve :: Text -> IO Bool         retrieve packString = do-            collectorPath   <- liftIO $ getCollectorPath+            collectorPath   <- liftIO getCollectorPath             setCurrentDirectory collectorPath             let fullUrl  = T.unpack (retrieveURL prefs) <> "/metadata-" <> leksahVersion <> "/" <> T.unpack packString <> leksahMetadataSystemFileExtension                 filePath = collectorPath </> T.unpack packString <.> leksahMetadataSystemFileExtension@@ -189,7 +183,7 @@  writeExtractedPackage :: MonadIO m => Bool -> PackageDescr -> m () writeExtractedPackage writeAscii pd = do-    collectorPath   <- liftIO $ getCollectorPath+    collectorPath   <- liftIO getCollectorPath     let filePath    =  collectorPath </> T.unpack (packageIdentifierToString $ pdPackage pd) <.>                             leksahMetadataSystemFileExtension     if writeAscii@@ -198,7 +192,7 @@  writePackagePath :: MonadIO m => FilePath -> Text -> m () writePackagePath fp packageName = do-    collectorPath   <- liftIO $ getCollectorPath+    collectorPath   <- liftIO getCollectorPath     let filePath    =  collectorPath </> T.unpack packageName <.> leksahMetadataPathFileExtension     liftIO $ writeFile filePath fp 

@@ -127,7 +127,7 @@                     exists <- doesDirectoryExist fpUnpack                     unless exists $ createDirectory fpUnpack                     setCurrentDirectory fpUnpack-                    runTool' "cabal" (["unpack",packageName]) Nothing+                    runTool' "cabal" ["unpack", packageName] Nothing                     success <- doesDirectoryExist (fpUnpack </> packageName')                     if not success                         then return (Left "Failed to download and unpack source")@@ -146,7 +146,7 @@     where         _handler' (_e :: NewException.SomeException) = do             debugM "leksah-server" "would block"-            return ([])+            return []         handler (e :: NewException.SomeException) = do             warningM "leksah-server" ("Ghc failed to process: " ++ show e ++ " (" ++ cabalPath ++ ")")             return (Nothing, PackageCollectStats packageName Nothing False False@@ -216,26 +216,26 @@ extractDescrs dflags pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =         transformToDescrs dflags pm exportedDeclInfo ++ map (toDescrInst dflags pm) ifaceInstances'     where-        exportedDeclInfo                               =  mapMaybe toDeclInfo  ifaceExportItems'+        exportedDeclInfo                    =  mapMaybe toDeclInfo  ifaceExportItems'         toDeclInfo ExportDecl{expItemDecl=decl, expItemMbDoc=mbDoc, expItemSubDocs=subDocs}   =                                         Just(decl,getDoc $ fst mbDoc,map (\ (a,b) -> (a,getDoc $ fst b)) subDocs)-        toDeclInfo (ExportNoDecl _ _)                  = Nothing-        toDeclInfo (ExportGroup _ _ _)                 = Nothing-        toDeclInfo (ExportDoc _)                       = Nothing-        toDeclInfo (ExportModule _)                    = Nothing+        toDeclInfo (ExportNoDecl{})         = Nothing+        toDeclInfo (ExportGroup{})          = Nothing+        toDeclInfo (ExportDoc{})            = Nothing+        toDeclInfo (ExportModule{})         = Nothing  transformToDescrs :: DynFlags -> PackModule -> [(LHsDecl Name, Maybe NDoc, [(Name, Maybe NDoc)])] -> [Descr] transformToDescrs dflags pm = concatMap transformToDescr     where #if MIN_VERSION_ghc(7,10,0)-    transformToDescr ((L loc (SigD (TypeSig names typ _))), mbComment,_subCommentList) = map nameDescr names+    transformToDescr (L loc (SigD (TypeSig names typ _)), mbComment, _subCommentList) = map nameDescr names #elif MIN_VERSION_ghc(7,2,0)     transformToDescr ((L loc (SigD (TypeSig names typ))), mbComment,_subCommentList) = map nameDescr names #else     transformToDescr ((L loc (SigD (TypeSig name' typ))), mbComment,_subCommentList) = [nameDescr name'] #endif       where-        nameDescr name = Real $ RealDescr {+        nameDescr name = Real RealDescr {                 dscName'        =   T.pack . getOccString $ unLoc name             ,   dscMbTypeStr'   =   Just . BS.pack $ getOccString (unLoc name) <> " :: " <> showSDocUnqual dflags (ppr typ)             ,   dscMbModu'      =   Just pm@@ -244,11 +244,11 @@             ,   dscTypeHint'    =   VariableDescr             ,   dscExported'    =   True} -    transformToDescr ((L _loc (SigD _)), _mbComment, _subCommentList) = []+    transformToDescr (L _loc (SigD _), _mbComment, _subCommentList) = []  #if MIN_VERSION_ghc(7,6,0)-    transformToDescr ((L loc for@(ForD (ForeignImport lid _ _ _))), mbComment,_sigList) =-        [Real $ RealDescr {+    transformToDescr (L loc for@(ForD (ForeignImport lid _ _ _)), mbComment, _sigList) =+        [Real RealDescr {         dscName'        =   T.pack . getOccString $ unLoc lid     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr for     ,   dscMbModu'      =   Just pm@@ -258,11 +258,11 @@     ,   dscExported'    =   True}]  #if MIN_VERSION_ghc(7,7,0)-    transformToDescr ((L loc (TyClD typ@(FamDecl {tcdFam = (FamilyDecl {fdLName = lid})}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(FamDecl {tcdFam = (FamilyDecl {fdLName = lid})})), mbComment,_sigList) = #else-    transformToDescr ((L loc (TyClD typ@(TyFamily {tcdLName = lid}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(TyFamily {tcdLName = lid})), mbComment,_sigList) = #endif-        [Real $ RealDescr {+        [Real RealDescr {         dscName'        =   T.pack . getOccString $ unLoc lid     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm@@ -273,13 +273,13 @@ #endif  #if MIN_VERSION_ghc(7,7,0)-    transformToDescr ((L loc (TyClD typ@(SynDecl {tcdLName = lid}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(SynDecl {tcdLName = lid})), mbComment,_sigList) = #elif MIN_VERSION_ghc(7,6,0)-    transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TySynonym {}}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TySynonym {}})), mbComment,_sigList) = #else-    transformToDescr ((L loc (TyClD typ@(TySynonym lid _ _ _ ))), mbComment, _subCommentList) =+    transformToDescr (L loc (TyClD typ@(TySynonym lid _ _ _ )), mbComment, _subCommentList) = #endif-        [Real $ RealDescr {+        [Real RealDescr {         dscName'        =   T.pack . getOccString $ unLoc lid     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm@@ -289,21 +289,21 @@     ,   dscExported'    =   True}]  #if MIN_VERSION_ghc(7,7,0)-    transformToDescr ((L loc (TyClD typ@(DataDecl {tcdLName = lid, tcdDataDefn = HsDataDefn {dd_cons=lConDecl, dd_derivs=tcdDerivs'}}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(DataDecl {tcdLName = lid, tcdDataDefn = HsDataDefn {dd_cons=lConDecl, dd_derivs=tcdDerivs'}})), mbComment,_sigList) = #elif MIN_VERSION_ghc(7,6,0)-    transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TyData {td_cons=lConDecl, td_derivs=tcdDerivs'}}))), mbComment,_sigList) =+    transformToDescr (L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TyData {td_cons=lConDecl, td_derivs=tcdDerivs'}})), mbComment,_sigList) = #else-    transformToDescr ((L loc (TyClD typ@(TyData DataType _ lid _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) =+    transformToDescr (L loc (TyClD typ@(TyData DataType _ lid _ _ _ lConDecl tcdDerivs')), mbComment,_subCommentList) = #endif-        [Real $ RealDescr {+        Real RealDescr {         dscName'        =   T.pack name     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags . ppr $ uncommentData typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []     ,   dscTypeHint'    =   DataDescr constructors fields-    ,   dscExported'    =   True}]-            ++ derivings tcdDerivs'+    ,   dscExported'    =   True}+            : derivings tcdDerivs'         where         constructors    =   concatMap (extractConstructor dflags) lConDecl         fields          =   nub $ concatMap (extractRecordFields dflags) lConDecl@@ -333,8 +333,8 @@         derivings (Just _l) = [] #endif -    transformToDescr ((L loc (TyClD cl@(ClassDecl{tcdLName=tcdLName', tcdSigs=tcdSigs', tcdDocs=docs}))), mbComment,_subCommentList) =-        [Real $ RealDescr {+    transformToDescr (L loc (TyClD cl@(ClassDecl{tcdLName=tcdLName', tcdSigs=tcdSigs', tcdDocs=docs})), mbComment,_subCommentList) =+        [Real RealDescr {         dscName'        =   T.pack . getOccString $ unLoc tcdLName'     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr cl{tcdMeths = emptyLHsBinds}     ,   dscMbModu'      =   Just pm@@ -355,7 +355,7 @@ toDescrInst :: DynFlags -> PackModule -> Instance -> Descr toDescrInst dflags pm inst@(Instance is_cls' _is_tcs _is_tvs is_tys' _is_dfun _is_flag) = #endif-        Real $ RealDescr {+        Real RealDescr {         dscName'        =   T.pack $ getOccString is_cls'     ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr inst     ,   dscMbModu'      =   Just pm@@ -371,11 +371,11 @@  extractMethod :: DynFlags -> (LHsDecl Name, Maybe NDoc) -> [SimpleDescr] #if MIN_VERSION_ghc(7,10,0)-extractMethod dflags ((L loc (SigD ts@(TypeSig names _typ _))), mbDoc) = map extractName names+extractMethod dflags (L loc (SigD ts@(TypeSig names _typ _)), mbDoc) = map extractName names #elif MIN_VERSION_ghc(7,2,0)-extractMethod dflags ((L loc (SigD ts@(TypeSig names _typ))), mbDoc) = map extractName names+extractMethod dflags (L loc (SigD ts@(TypeSig names _typ)), mbDoc) = map extractName names #else-extractMethod dflags ((L loc (SigD ts@(TypeSig name' _typ))), mbDoc) = [extractName name']+extractMethod dflags (L loc (SigD ts@(TypeSig name' _typ)), mbDoc) = [extractName name'] #endif   where   extractName name =@@ -460,9 +460,9 @@     showsPrec _ (PPDoc _ DocEmpty)                 =   id     showsPrec _ (PPDoc d (DocAppend l r))          =   shows (PPDoc d l)  . shows (PPDoc d r)     showsPrec _ (PPDoc _ (DocString str))          =   showString str-    showsPrec _ (PPDoc d (DocParagraph doc))         =   shows (PPDoc d doc) . showChar '\n'+    showsPrec _ (PPDoc d (DocParagraph doc))       =   shows (PPDoc d doc) . showChar '\n'     showsPrec _ (PPDoc d (DocIdentifier l))        =   foldr (\i _f -> showChar '\'' .-                                                     ((showString . showSDoc d .  ppr) i) . showChar '\'') id [l]+                                                     (showString . showSDoc d . ppr) i . showChar '\'') id [l]     showsPrec _ (PPDoc _ (DocModule str))          =   showChar '"' . showString str . showChar '"'     showsPrec _ (PPDoc d (DocEmphasis doc))        =   showChar '/' . shows (PPDoc d doc)  . showChar '/'     showsPrec _ (PPDoc d (DocMonospaced doc))      =   showChar '@' . shows (PPDoc d doc) . showChar '@'@@ -482,14 +482,15 @@     showsPrec _ (PPDoc _ _)                       =   id  attachComments' :: DynFlags -> [LSig Name] -> [MyLDocDecl] -> [(LHsDecl Name, Maybe (HsDoc Name))]-attachComments' dflags sigs docs = collectDocs' dflags $ sortByLoc $-        ((map (\ (L l i) -> L l (SigD i)) sigs) ++ (map (\ (L l i) -> L l (DocD i)) docs))+attachComments' dflags sigs docs = collectDocs' dflags $ sortByLoc+                                                           (map (\ (L l i) -> L l (SigD i)) sigs +++                                                              map (\ (L l i) -> L l (DocD i)) docs)  -- | Collect the docs and attach them to the right declaration.-collectDocs' :: DynFlags -> [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]+collectDocs' :: DynFlags -> [LHsDecl Name] -> [(LHsDecl Name, Maybe (HsDoc Name))] collectDocs' dflags = collect' dflags Nothing DocEmpty -collect' :: DynFlags -> Maybe (LHsDecl Name) -> HsDoc Name -> [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]+collect' :: DynFlags -> Maybe (LHsDecl Name) -> HsDoc Name -> [LHsDecl Name] -> [(LHsDecl Name, Maybe (HsDoc Name))] collect' _dflags d doc_so_far [] =    case d of         Nothing -> []@@ -508,8 +509,8 @@       Nothing -> collect' dflags (Just e) doc_so_far es       Just d0 -> finishedDoc' d0 doc_so_far (collect' dflags (Just e) DocEmpty es) -finishedDoc' :: LHsDecl alpha -> NDoc -> [(LHsDecl alpha, (Maybe ((HsDoc Name))))]-                    -> [(LHsDecl alpha, (Maybe ((HsDoc Name))))]+finishedDoc' :: LHsDecl alpha -> NDoc -> [(LHsDecl alpha, Maybe (HsDoc Name))]+                    -> [(LHsDecl alpha, Maybe (HsDoc Name))] finishedDoc' d doc rest | isEmptyDoc doc = (d, Nothing) : rest finishedDoc' d doc rest | notDocDecl d   = (d, Just doc) : rest   where

@@ -82,12 +82,11 @@                 buildSourceForPackageDB prefs                 mbSources' <- parseSourceForPackageDB                 case mbSources' of-                    Just map'' -> do-                        return map''+                    Just map'' -> return map''                     Nothing ->  error "can't build/open source for package file"  sourceForPackage :: PackageIdentifier-    -> (Map PackageIdentifier [FilePath])+    -> Map PackageIdentifier [FilePath]     -> Maybe FilePath sourceForPackage pid pmap =     case pid `Map.lookup` pmap of@@ -116,7 +115,7 @@ showSourceForPackageDB aMap = PP.vcat (map showIt (Map.toList aMap))     where     showIt :: (Text,[FilePath]) -> PP.Doc-    showIt (pd,list) =  (foldl' (\l n -> l PP.$$ (PP.text $ show n)) label list)+    showIt (pd,list) =  foldl' (\l n -> l PP.$$ PP.text (show n)) label list                              PP.<>  PP.char '\n'         where label  =  PP.text (T.unpack pd) PP.<> PP.colon @@ -194,9 +193,9 @@ filePathParser = try (do     whiteSpace     char '"'-    str <- many (noneOf ['"'])+    str <- many (noneOf "\"")     char '"'-    return (str))+    return str)     <?> "filePathParser"  parseCabal :: FilePath -> IO (Maybe Text)@@ -217,11 +216,11 @@     r1 <- cabalMinimalP     r2 <- cabalMinimalP     case r1 of-        Left v -> do+        Left v ->             case r2 of                 Right n -> return (n <> "-" <> v)                 Left _ -> unexpected "Illegal cabal"-        Right n -> do+        Right n ->             case r2 of                 Left v -> return (n <> "-" <> v)                 Right _ -> unexpected "Illegal cabal"@@ -230,15 +229,15 @@ cabalMinimalP =     do  try $(symbol "name:" <|> symbol "Name:")         whiteSpace-        name       <-  (many $noneOf " \n")-        (many $noneOf "\n")+        name       <-  many $noneOf " \n"+        many $noneOf "\n"         char '\n'         return . Right $ T.pack name     <|> do             try $(symbol "version:" <|> symbol "Version:")             whiteSpace-            versionString    <-  (many $noneOf " \n")-            (many $noneOf "\n")+            versionString    <-  many $noneOf " \n"+            many $noneOf "\n"             char '\n'             return . Left $ T.pack versionString     <|> do@@ -252,7 +251,7 @@     exePath <- getExecutablePath     if takeFileName exePath `elem` ["leksah-server.exe", "leksah.exe"]         then do-            let dataDir = (takeDirectory $ takeDirectory exePath) </> "leksah"+            let dataDir = takeDirectory (takeDirectory exePath) </> "leksah"             exists <- doesDirectoryExist dataDir             if exists then return dataDir else P.getDataDir         else P.getDataDir

@@ -53,8 +53,8 @@        (splitFileName, dropExtension, takeExtension,         combine, addExtension, (</>), normalise, splitPath, takeFileName) import Distribution.ModuleName (toFilePath, ModuleName)-import Control.Monad (foldM, filterM)-import Data.Maybe (catMaybes)+import Control.Monad (when, foldM, filterM)+import Data.Maybe (mapMaybe, catMaybes) import Distribution.Simple.PreProcess.Unlit (unlit) import System.Directory        (canonicalizePath, doesDirectoryExist, doesFileExist,@@ -120,7 +120,7 @@     -> IO (Maybe FilePath) findSourceFile directories exts modId  =     let modulePath      =   toFilePath modId-        allPathes       =   map (\ d -> d </> modulePath) directories+        allPathes       =   map (</> modulePath) directories         allPossibles    =   concatMap (\ p -> map (addExtension p) exts)                                 allPathes     in  find' allPossibles@@ -129,7 +129,7 @@     -> FilePath     -> IO (Maybe FilePath) findSourceFile' directories modulePath  =-    let allPathes       =   map (\ d -> d </> modulePath) directories+    let allPathes       =   map (</> modulePath) directories     in  find' allPathes  @@ -199,19 +199,17 @@     if exists         then do             filesAndDirs <- getDirectoryContents filePath-            let filesAndDirs' = map (\s -> combine filePath s)+            let filesAndDirs' = map (combine filePath)                                     $filter (\s -> s /= "." && s /= ".." && s /= "_darcs" && s /= "dist"                                         && s /= "Setup.lhs") filesAndDirs-            dirs <-  filterM (\f -> doesDirectoryExist f) filesAndDirs'-            files <-  filterM (\f -> doesFileExist f) filesAndDirs'+            dirs <-  filterM doesDirectoryExist filesAndDirs'+            files <-  filterM doesFileExist filesAndDirs'             let hsFiles =   filter (\f -> let ext = takeExtension f in                                             ext == ".hs" || ext == ".lhs") files             mbModuleStrs <- mapM moduleNameFromFilePath hsFiles-            let mbModuleNames = catMaybes $-                                    map (\n -> case n of-                                                    Nothing -> Nothing-                                                    Just s -> simpleParse $ T.unpack s)-                                        mbModuleStrs+            let mbModuleNames = mapMaybe+                                  (maybe Nothing (simpleParse . T.unpack))+                                  mbModuleStrs             otherModules <- mapM allModules dirs             return (mbModuleNames ++ concat otherModules)         else return [])@@ -232,17 +230,15 @@     if exists         then do             filesAndDirs <- getDirectoryContents filePath-            let filesAndDirs' = map (\s -> combine filePath s)+            let filesAndDirs' = map (combine filePath)                                     $filter (\s -> s /= "." && s /= ".." && s /= "_darcs") filesAndDirs-            dirs    <-  filterM (\f -> doesDirectoryExist f) filesAndDirs'-            files   <-  filterM (\f -> doesFileExist f) filesAndDirs'+            dirs    <-  filterM doesDirectoryExist filesAndDirs'+            files   <-  filterM doesFileExist filesAndDirs'             let choosenFiles =   filter (\f -> let ext = takeExtension f in                                                     elem ext extensions) files-            allFiles <--                if recurseFurther || (not recurseFurther && null choosenFiles)-                    then foldM (allFilesWithExtensions extensions recurseFurther) (choosenFiles ++ collecting) dirs-                    else return (choosenFiles ++ collecting)-            return (allFiles)+            if recurseFurther || (not recurseFurther && null choosenFiles)+                then foldM (allFilesWithExtensions extensions recurseFurther) (choosenFiles ++ collecting) dirs+                else return (choosenFiles ++ collecting)         else return collecting)             $ \ (_ :: SomeException) -> return collecting @@ -269,8 +265,7 @@         Left str' -> do             let parseRes = parse moduleNameParser fp str'             case parseRes of-                Left _ -> do-                    return Nothing+                Left _ -> return Nothing                 Right str'' -> return (Just str'')  lexer :: P.TokenParser st@@ -291,12 +286,11 @@     many skipPreproc     whiteSpace     symbol "module"-    str <- lexeme mident-    return str+    lexeme mident     <?> "module identifier"  skipPreproc :: CharParser () ()-skipPreproc = do+skipPreproc =     try (do         whiteSpace         char '#'@@ -318,7 +312,7 @@     let nameList    =   map (T.pack . dropExtension) $             filter (\s -> leksahMetadataSystemFileExtension `isSuffixOf` s) paths     return (Set.fromList nameList))-        $ \ (_ :: SomeException) -> return (Set.empty)+        $ \ (_ :: SomeException) -> return Set.empty  isEmptyDirectory :: FilePath -> IO Bool isEmptyDirectory filePath = E.catch (do@@ -336,7 +330,7 @@     if exists         then do             filesAndDirs <- map (filePath </>) <$> getDirectoryContents filePath-            files <-  filterM (\f -> doesFileExist f) filesAndDirs+            files <-  filterM doesFileExist filesAndDirs             case filter (\f -> let ext = takeExtension f in ext == ".cabal") files of                 [f] -> return (Just f)                 []  -> return Nothing@@ -369,25 +363,23 @@ autoExtractTarFiles' filePath =     E.catch (do         exists <- doesDirectoryExist filePath-        if exists-            then do-                filesAndDirs             <- getDirectoryContents filePath-                let filesAndDirs'        =  map (\s -> combine filePath s)-                                                $ filter (\s -> s /= "." && s /= ".." && not (isPrefixOf "00-index" s)) filesAndDirs-                dirs                     <- filterM (\f -> doesDirectoryExist f) filesAndDirs'-                files                    <- filterM (\f -> doesFileExist f) filesAndDirs'-                let choosenFiles         =  filter (\f -> isSuffixOf ".tar.gz" f) files-                let decompressionTargets =  filter (\f -> (dropExtension . dropExtension) f `notElem` dirs) choosenFiles-                mapM_ (\f -> let (dir,fn) = splitFileName f-                                 command = "tar -zxf " ++ fn in do-                                    setCurrentDirectory dir-                                    handle   <- runCommand command-                                    waitForProcess handle-                                    return ())-                        decompressionTargets-                mapM_ autoExtractTarFiles' dirs-                return ()-            else return ()+        when exists $ do+            filesAndDirs             <- getDirectoryContents filePath+            let filesAndDirs'        =  map (combine filePath)+                                            $ filter (\s -> s /= "." && s /= ".." && not ("00-index" `isPrefixOf` s)) filesAndDirs+            dirs                     <- filterM doesDirectoryExist filesAndDirs'+            files                    <- filterM doesFileExist filesAndDirs'+            let choosenFiles         =  filter (isSuffixOf ".tar.gz") files+            let decompressionTargets =  filter (\f -> (dropExtension . dropExtension) f `notElem` dirs) choosenFiles+            mapM_ (\f -> let (dir,fn) = splitFileName f+                             command = "tar -zxf " ++ fn in do+                                setCurrentDirectory dir+                                handle   <- runCommand command+                                waitForProcess handle+                                return ())+                    decompressionTargets+            mapM_ autoExtractTarFiles' dirs+            return ()     ) $ \ (_ :: SomeException) -> return ()  @@ -421,12 +413,12 @@     output `deepseq` return $ Right $ concatMap names output     ) $ \ (e :: SomeException) -> return . Left . T.pack $ show e   where-    names (ToolOutput n) = catMaybes (map (T.simpleParse . T.unpack) (T.words n))+    names (ToolOutput n) = mapMaybe (T.simpleParse . T.unpack) (T.words n)     names _ = []  figureOutHaddockOpts :: IO [Text] figureOutHaddockOpts = do-    (!output,_) <- runTool' "cabal" (["haddock","--with-haddock=leksahecho","--executables"]) Nothing+    (!output,_) <- runTool' "cabal" ["haddock", "--with-haddock=leksahecho", "--executables"] Nothing     let opts = concat [words $ T.unpack l | ToolOutput l <- output]     let res = filterOptGhc opts     debugM "leksah-server" ("figureOutHaddockOpts " ++ show res)@@ -445,7 +437,7 @@     let res = case catMaybes [findMake $ T.unpack l | ToolOutput l <- output] of                 options:_ -> words options                 _         -> []-    debugM "leksah-server" $ ("figureOutGhcOpts " ++ show res)+    debugM "leksah-server" ("figureOutGhcOpts " ++ show res)     output `deepseq` return $ map T.pack res     where         findMake :: String -> Maybe String

@@ -69,6 +69,7 @@ import Data.Text (Text) import qualified Data.Text as T (pack, unpack) import Data.Monoid ((<>))+import Data.Function (on)  #if !MIN_VERSION_ghc(7,7,0) -- this should not be repeated here, why is it necessary?@@ -88,9 +89,9 @@     runGhc (Just libDir) $ do         dynflags  <- getSessionDynFlags #if MIN_VERSION_ghc(7,7,0)-        let dynflags' = foldl (\ flags'' flag' -> gopt_set flags'' flag') dynflags udynFlags+        let dynflags' = foldl gopt_set dynflags udynFlags #else-        let dynflags' = foldl (\ flags'' flag' -> dopt_set flags'' flag') dynflags udynFlags+        let dynflags' = foldl dopt_set dynflags udynFlags #endif         let dynflags'' = dynflags' {             hscTarget = HscNothing,@@ -110,7 +111,7 @@         (dynflags', rest, _) <- parseDynamicFlags dynflags flags_         if not (null rest)             then do-                liftIO $ debugM "leksah-server" ("No dynamic GHC options: " ++ (unwords (map unLoc rest)))+                liftIO $ debugM "leksah-server" ("No dynamic GHC options: " ++ unwords (map unLoc rest))                 return dynflags'             else return dynflags' @@ -127,10 +128,9 @@ #if !MIN_VERSION_ghc(7,6,0)     setSessionDynFlags $ dopt_set dflags1 Opt_ReadUserPackageConf #endif-    pkgInfos        <-  case pkgDatabase dflags1 of-                            Nothing -> return []-                            Just fm -> return fm-    return pkgInfos+    case pkgDatabase dflags1 of+        Nothing -> return []+        Just fm -> return fm  findFittingPackages :: [Dependency] -> Ghc [PackageIdentifier] findFittingPackages dependencyList = do@@ -147,7 +147,7 @@                                     name == dname && withinRange version versionRange)                         packages         in  if length filtered > 1-                then [maximumBy (\a b -> compare (pkgVersion a) (pkgVersion b)) filtered]+                then [maximumBy (compare `on` pkgVersion) filtered]                 else filtered   ---------------------------------------------------------------------

@@ -1,5 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -XRecordWildCards -XCPP -XBangPatterns -fno-warn-orphans #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Utils.Tool@@ -94,6 +96,7 @@ import Data.Text (replace, Text) import Data.Monoid ((<>)) import Data.Text.IO (hPutStrLn)+import Control.Arrow (Arrow(..))  data ToolOutput = ToolInput Text                 | ToolError Text@@ -135,7 +138,7 @@ toolline (ToolExit _code) = ""  quoteArg :: Text -> Text-quoteArg s | T.any (==' ') s = "\"" <> (escapeQuotes s) <> "\""+quoteArg s | T.any (==' ') s = "\"" <> escapeQuotes s <> "\"" quoteArg s                   = s  escapeQuotes :: Text -> Text@@ -220,7 +223,7 @@     isolateCommandOutput = isolateToFirst (not . isEndOfCommandOutput)      processCommand [] _ = do-        liftIO $ debugM "leksah-server" $ "No More Commands"+        liftIO $ debugM "leksah-server" "No More Commands"         return ()     processCommand ((command@(ToolCommand commandString rawCommandString handler)):remainingCommands) inp = do         liftIO $ do@@ -228,35 +231,34 @@             putMVar (currentToolCommand tool) command             hPutStrLn inp commandString             hFlush inp-        (mapM (C.yield . ToolInput) (T.lines rawCommandString) >> isolateCommandOutput) =$ handler+        (mapM_ (C.yield . ToolInput) (T.lines rawCommandString) >> isolateCommandOutput) =$ handler         processCommand remainingCommands inp      outputSequence :: Handle -> C.Conduit RawToolOutput IO ToolOutput     outputSequence inp =-        CL.concatMapAccumM writeCommandOutput (False, False, (outputSyncCommand clr), 0, "")+        CL.concatMapAccumM writeCommandOutput (False, False, outputSyncCommand clr, 0, "")       where-        writeCommandOutput (RawToolOutput (ToolPrompt line)) (False, False, (Just outSyncCmd), n, _) = do-            debugM "leksah-server" $ "Pre Sync Prompt"+        writeCommandOutput (RawToolOutput (ToolPrompt line)) (False, False, Just outSyncCmd, n, _) = do+            debugM "leksah-server" "Pre Sync Prompt"             hPutStrLn inp $ outSyncCmd n             hFlush inp-            return ((True, False, (Just outSyncCmd), n, line), [])+            return ((True, False, Just outSyncCmd, n, line), [])         writeCommandOutput (RawToolOutput (ToolPrompt _))(True, False, mbSyncCmd, n, promptLine) = do-            debugM "leksah-server" $ "Unsynced Prompt"+            debugM "leksah-server" "Unsynced Prompt"             return ((True, False, mbSyncCmd, n, promptLine), [])         writeCommandOutput (RawToolOutput o@(ToolOutput line)) (True, False, mbSyncCmd, n, promptLine) = do-            let synced = (isExpectedOutput clr n line)-            when synced $ debugM "leksah-server" $ "Output Sync Found"+            let synced = isExpectedOutput clr n line+            when synced $ debugM "leksah-server" "Output Sync Found"             return ((True, synced, mbSyncCmd, n, promptLine), if synced then [] else [o])         writeCommandOutput (RawToolOutput (ToolPrompt _)) (_, _, mbSyncCmd, n, promptLine) = do-            debugM "leksah-server" $ "Synced Prompt - Ready For Next Command"+            debugM "leksah-server" "Synced Prompt - Ready For Next Command"             tryTakeMVar (currentToolCommand tool)             return ((False, False, mbSyncCmd, n+1, promptLine), [ToolPrompt promptLine])         writeCommandOutput (RawToolOutput o@(ToolExit _)) s = do-            debugM "leksah-server" $ "Tool Exit"+            debugM "leksah-server" "Tool Exit"             putMVar (outputClosed tool) True             return (s, [o])-        writeCommandOutput (RawToolOutput o) s = do-            return (s, [o])+        writeCommandOutput (RawToolOutput o) s = return (s, [o])         writeCommandOutput x s = do             debugM "leksah-server" $ "Unexpected output " ++ show x             return (s, [])@@ -283,19 +285,19 @@  ghciParseInitialPrompt :: AP.Parser Text ghciParseInitialPrompt = (do-        ((AP.string "Prelude") <|> (AP.string "*") <|> (AP.string ">"))+        AP.string "Prelude" <|> AP.string "*" <|> AP.string ">"         AP.skipWhile (\c -> c /= '>' && c/= '\n')         AP.string "> "         return "")     <?> "ghciParseInitialPrompt"  ghciParseFollowingPrompt :: AP.Parser Text-ghciParseFollowingPrompt = (do-        T.pack <$> AP.satisfy (/='\n') `AP.manyTill` (AP.string ghciPrompt))+ghciParseFollowingPrompt = (+        T.pack <$> AP.satisfy (/= '\n') `AP.manyTill` AP.string ghciPrompt)     <?> "ghciParseFollowingPrompt"  marker :: Int -> Text-marker n = "kMAKWRALZZbHdXfHUOAAYBB" <> (T.pack $ show n)+marker n = "kMAKWRALZZbHdXfHUOAAYBB" <> T.pack (show n)  parseMarker :: AP.Parser Int parseMarker = (do@@ -328,16 +330,16 @@     where scan = liftA (\b -> ([], b)) end <|> liftA2 (\a (as, b) -> (a:as, b)) p scan  ghciParseExpectedError :: AP.Parser (Text, Int)-ghciParseExpectedError = (do-      (\(a, b) -> (T.pack a, b)) <$> AP.satisfy (/='\n') `manyTill'` (do+ghciParseExpectedError = (+      first T.pack <$> AP.satisfy (/='\n') `manyTill'` (do         AP.string "\n<interactive>:"         AP.takeWhile1 isDigit         AP.string ":"         ghciParseExpectedErrorCols         AP.string ": Not in scope: "-        (AP.char '`' <|> AP.char '‛' <|> AP.char '‘')+        AP.char '`' <|> AP.char '‛' <|> AP.char '‘'         result <- parseMarker-        (AP.char '\'' <|> AP.char '’')+        AP.char '\'' <|> AP.char '’'         AP.string "\n"         return result))     <?> "ghciParseExpectedError"@@ -372,7 +374,7 @@         return $ Left expected)     <|> (do         line <- AP.takeWhile (/= '\n')-        (AP.endOfInput <|> AP.endOfLine)+        AP.endOfInput <|> AP.endOfLine         return $ Right line)     <?> "parseError" @@ -382,7 +384,7 @@     hSetBuffering out NoBuffering     hSetBuffering err NoBuffering     mvar <- newEmptyMVar-    foundExpectedError <- liftIO $ newEmptyMVar+    foundExpectedError <- liftIO newEmptyMVar     forkIO $ do         readError mvar err foundExpectedError         putMVar mvar ToolErrClosed@@ -410,7 +412,7 @@     readError mvar errors foundExpectedError = do         CB.sourceHandle errors $= CT.decode CT.utf8                     $= CL.map (T.filter (/= '\r'))-                    $= (CL.sequence (sinkParser (parseError $ parseExpectedError clr)))+                    $= CL.sequence (sinkParser (parseError $ parseExpectedError clr))                     $$ sendErrors         hClose errors       where@@ -425,25 +427,25 @@     outputSequence :: AP.Parser ToolOutput -> AP.Parser ToolOutput -> C.Conduit Text IO ToolOutput     outputSequence i1 i2 = loop       where-        loop = C.await >>= maybe (return ()) (\x -> C.leftover x >> (sinkParser i1) >>= check)+        loop = C.await >>= maybe (return ()) (\x -> C.leftover x >> sinkParser i1 >>= check)         check line@(ToolPrompt _) = C.yield line >> CL.sequence (sinkParser i2)         check line = C.yield line >> loop      readOutput :: MVar RawToolOutput -> Handle -> MVar Int -> IO ()     readOutput mvar output foundExpectedError = do-        let parseLines parsePrompt = ((do+        let parseLines parsePrompt = (do                     lineSoFar <- parsePrompt                     return $ ToolPrompt lineSoFar)                 <|> (do                     line <- AP.takeWhile (/= '\n')-                    (AP.endOfInput <|> AP.endOfLine)+                    AP.endOfInput <|> AP.endOfLine                     return $ ToolOutput line)-                <?> "parseLines")+                <?> "parseLines"             parseInitialLines = parseLines (parseInitialPrompt clr)             parseFollowinglines = parseLines (parseFollowingPrompt clr)         CB.sourceHandle output $= CT.decode CT.utf8                     $= CL.map (T.filter (/= '\r'))-                    $= (outputSequence (parseInitialLines) (parseFollowinglines))+                    $= outputSequence parseInitialLines parseFollowinglines                     $$ sendErrors         hClose output       where@@ -454,13 +456,13 @@                     liftIO $ debugM "leksah-server" $ "sendErrors " ++ show mbx                     case mbx of                         Nothing -> return ()-                        Just x@(ToolPrompt line) -> do+                        Just x@(ToolPrompt line) ->                             case (counter, errSynced, errorSyncCommand clr) of-                                (0, _, _) -> do+                                (0, _, _) ->                                     loop (counter+1) errSynced line                                 (_, False, Just syncCmd) -> do                                     liftIO $ do-                                        debugM "leksah-server" $ "sendErrors - Sync " ++ (T.unpack $ syncCmd counter)+                                        debugM "leksah-server" $ "sendErrors - Sync " ++ T.unpack (syncCmd counter)                                         hPutStrLn inp $ syncCmd counter                                         hFlush inp                                         waitForError counter@@ -491,7 +493,7 @@     output <- getOutput noInputCommandLineReader inp out err pid     return $ output $= CL.concatMap fromRawOutput -newGhci' :: [Text] -> (C.Sink ToolOutput IO ()) -> IO ToolState+newGhci' :: [Text] -> C.Sink ToolOutput IO () -> IO ToolState newGhci' flags startupOutputHandler = do     tool <- newToolState     writeChan (toolCommands tool) $@@ -499,7 +501,7 @@     runInteractiveTool tool ghciCommandLineReader "ghci" flags Nothing     return tool -newGhci :: FilePath -> Maybe Text -> [Text] -> (C.Sink ToolOutput IO ()) -> IO ToolState+newGhci :: FilePath -> Maybe Text -> [Text] -> C.Sink ToolOutput IO () -> IO ToolState newGhci dir mbExe interactiveFlags startupOutputHandler = do         tool <- newToolState         writeChan (toolCommands tool) $@@ -509,16 +511,16 @@         return tool  executeCommand :: ToolState -> Text -> Text -> C.Sink ToolOutput IO () -> IO ()-executeCommand tool command rawCommand handler = do+executeCommand tool command rawCommand handler =     writeChan (toolCommands tool) $ ToolCommand command rawCommand handler  executeGhciCommand :: ToolState -> Text -> C.Sink ToolOutput IO () -> IO ()-executeGhciCommand tool command handler = do+executeGhciCommand tool command handler =     if '\n' `elem` T.unpack command         then executeCommand tool safeCommand command handler         else executeCommand tool command command handler     where-        filteredLines = (filter safeLine (T.lines command))+        filteredLines = filter safeLine (T.lines command)         safeCommand = ":cmd (return " <> T.pack (show $ ":{\n" <> T.unlines filteredLines <> "\n:}") <> ")"         safeLine ":{" = False         safeLine ":}" = False

@@ -41,7 +41,7 @@ getGhcInfo :: IO Text getGhcInfo = E.catch (do     (!output,_) <- runTool' "ghc" ["--info"] Nothing-    output `deepseq` return $ T.unlines $ [l | ToolOutput l <- output]+    output `deepseq` return $ T.unlines [l | ToolOutput l <- output]     ) $ \ (e :: SomeException) -> error $ "FileUtils>>getGhcInfo failed with " ++ show e  getHaddockVersion :: IO Text