leksah-server 0.13.1.1 → 0.14.0.0

raw patch · 17 files changed

+368/−361 lines, 17 filesdep +conduit-extradep +resourcetdep ~attoparsecdep ~attoparsec-conduitdep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit-extra, resourcet

Dependency ranges changed: attoparsec, attoparsec-conduit, conduit, leksah-server, ltk

API changes (from Hackage documentation)

Files

• leksah-server.cabal +15/−11
• src/IDE/Core/CTypes.hs +56/−46
• src/IDE/Core/Serializable.hs +24/−10
• src/IDE/HeaderParser.hs +13/−11
• src/IDE/Metainfo/Collector.hs +24/−19
• src/IDE/Metainfo/InterfaceCollector.hs +17/−20
• src/IDE/Metainfo/PackageCollector.hs +18/−14
• src/IDE/Metainfo/SourceCollectorH.hs +57/−66
• src/IDE/Metainfo/SourceDB.hs +20/−16
• src/IDE/Metainfo/WorkspaceCollector.hs +45/−84
• src/IDE/StrippedPrefs.hs +3/−1
• src/IDE/Utils/FileUtils.hs +28/−25
• src/IDE/Utils/GHCUtils.hs +17/−13
• src/IDE/Utils/Server.hs +2/−1
• src/IDE/Utils/Tool.hs +19/−17
• src/IDE/Utils/VersionUtils.hs +6/−5
• src/LeksahEcho.hs +4/−2

@@ -1,5 +1,5 @@ name: leksah-server-version: 0.13.1.1+version: 0.14.0.0 cabal-version: >= 1.10.2 build-type: Simple license: GPL@@ -36,10 +36,11 @@                binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.11,                containers >=0.2.0.0 && <0.6, executable-path >=0.0.3 && <0.1,                directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.4, ghc >=7.0.4 && <7.9,-               ltk >=0.13.1.0 && <0.14, parsec >=2.1.0.1 && <3.2,+               ltk >=0.14.0.0 && <0.15, parsec >=2.1.0.1 && <3.2,                pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,-               hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.1,-               attoparsec-conduit >=1.0.1.2 && <1.1, attoparsec >=0.10.0.3 && <0.12,+               hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.2,+               conduit-extra >=1.0.0.1 && <1.2, resourcet,+               attoparsec-conduit >=1.0.1.2 && <1.2, attoparsec >=0.10.0.3 && <0.13,                transformers >=0.2.2.0 && <0.4, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.2     if (impl(ghc >= 7.8))        build-depends: haddock >= 2.7.2 && <2.15@@ -99,10 +100,11 @@                binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.11,                containers >=0.2.0.0 && <0.6, executable-path >=0.0.3 && <0.1,                directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.6, ghc >=7.0.4 && <7.9,-               ltk >=0.13.1.0 && <0.14, parsec >=2.1.0.1 && <3.2,+               ltk >=0.14.0.0 && <0.15, parsec >=2.1.0.1 && <3.2,                pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,-               hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.1,-               attoparsec-conduit >=1.0.1.2 && <1.1, attoparsec >=0.10.0.3 && <0.12,+               hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, conduit >= 1.0.8 && <1.2,+               conduit-extra >=1.0.0.1 && <1.2, resourcet,+               attoparsec-conduit >=1.0.1.2 && <1.2, attoparsec >=0.10.0.3 && <0.13,                transformers >=0.2.2.0 && <0.4, strict >=0.3.2 && <0.4, text >=0.11.3.1 && <1.2     if (impl(ghc >= 7.8))        build-depends: haddock >= 2.7.2 && <2.15@@ -173,8 +175,9 @@     ghc-prof-options: -auto-all -prof --    ghc-shared-options: -auto-all -prof     build-depends:  base >= 4.0.0.0 && <4.8, hslogger >= 1.0.7 && <1.3, deepseq >=1.1 && <1.4,-               bytestring >=0.9.0.1 && <0.11, conduit >= 1.0.8 && <1.1,-               attoparsec-conduit >=1.0.1.2 && <1.1, attoparsec >=0.10.0.3 && <0.12,+               bytestring >=0.9.0.1 && <0.11, conduit >= 1.0.8 && <1.2,+               conduit-extra >=1.0.0.1 && <1.2, resourcet,+               attoparsec-conduit >=1.0.1.2 && <1.2, attoparsec >=0.10.0.3 && <0.13,                transformers >=0.2.2.0 && <0.4, text >=0.11.3.1 && <1.2      if (impl(ghc >= 7.2))@@ -196,8 +199,9 @@     hs-source-dirs: tests     main-is:    TestTool.hs     build-depends: base >= 4.0.0.0 && <4.8,  hslogger >= 1.0.7 && <1.3,-               leksah-server == 0.13.1.1,-               HUnit >=1.2 && <1.3, transformers >=0.2.2.0 && <0.4, conduit >= 1.0.8 && <1.1+               leksah-server == 0.14.0.0,+               HUnit >=1.2 && <1.3, transformers >=0.2.2.0 && <0.4, conduit >= 1.0.8 && <1.2,+               conduit-extra >=1.0.0.1 && <1.2, resourcet      if (impl(ghc >= 7.2))        build-depends: process >= 1.1 && <1.3

@@ -1,5 +1,9 @@-{-# OPTIONS_GHC -XFlexibleInstances -XDeriveDataTypeable -XExistentialQuantification-    -XMultiParamTypeClasses -XFlexibleContexts -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Core.CTypes@@ -83,12 +87,17 @@ import Distribution.Text (simpleParse, display) import qualified Data.ByteString.Char8 as BS (unpack, empty) import qualified Data.Map as Map (lookup,keysSet,splitLookup, insertWith,empty,elems,union)-import Text.PrettyPrint as PP import Text.PrinterParser import Data.Char (isAlpha) import Control.DeepSeq (NFData(..)) import PackageConfig (PackageConfig) import qualified Distribution.InstalledPackageInfo as IPI+import Data.Text (Text)+import Data.Monoid ((<>))+import Text.PrettyPrint (fsep, Doc, (<+>), empty, text)+import qualified Text.PrettyPrint as PP+       (text, comma, punctuate, parens)+import qualified Data.Text as T (pack, tail, span, unpack) #if !MIN_VERSION_ghc(7,7,0) import Distribution.Package(PackageName(..)) #endif@@ -97,9 +106,9 @@ --  | Information about the system, extraced from .hi and source files -- -leksahVersion, configDirName :: String-leksahVersion = "0.13"-configDirName = ".leksah-" ++ leksahVersion+leksahVersion, configDirName :: FilePath+leksahVersion = "0.14"+configDirName = ".leksah-" <> leksahVersion  metadataVersion :: Integer metadataVersion = 7@@ -119,13 +128,13 @@             wcRebuild :: Bool,             wcPackage :: PackageIdentifier,             wcPath    :: FilePath,-            wcModList :: [(String,FilePath)]}+            wcModList :: [(Text,FilePath)]}     |   ParseHeaderCommand {             hcFilePath :: FilePath}     deriving (Eq,Ord,Show,Read)  data ServerAnswer = ServerOK-    | ServerFailed String+    | ServerFailed Text     | ServerHeader (Either [ImportDecl] Int)     deriving (Eq,Ord,Show,Read) @@ -134,15 +143,15 @@ data GenScope           =   forall alpha. SymbolTable alpha  => GenScopeC (PackScope alpha)  class SymbolTable alpha  where-    symLookup       :: String  -> alpha -> [Descr]-    symbols         :: alpha -> Set String-    symSplitLookup  :: String  -> alpha -> (alpha , Maybe [Descr], alpha)-    symInsert       :: String  -> [Descr] -> alpha -> alpha+    symLookup       :: Text  -> alpha -> [Descr]+    symbols         :: alpha -> Set Text+    symSplitLookup  :: Text  -> alpha -> (alpha , Maybe [Descr], alpha)+    symInsert       :: Text  -> [Descr] -> alpha -> alpha     symEmpty        :: alpha     symElems        :: alpha -> [[Descr]]     symUnion        :: alpha -> alpha -> alpha -instance SymbolTable (Map String [Descr]) where+instance SymbolTable (Map Text [Descr]) where     symLookup str smap  = case str `Map.lookup` smap of                                 Just dl -> dl                                 Nothing -> []@@ -166,7 +175,7 @@ newtype Present alpha       =   Present alpha  instance Show (Present PackageDescr) where-    show (Present pd)   =   (packageIdentifierToString . pdPackage) pd+    show (Present pd)   =   T.unpack $ (packageIdentifierToString . pdPackage) pd  instance Eq PackageDescr where     (== ) a b            =   pdPackage a == pdPackage b@@ -177,7 +186,7 @@ data ModuleDescr        =   ModuleDescr {         mdModuleId          ::   PackModule     ,   mdMbSourcePath      ::   (Maybe FilePath)                  -- unqualified-    ,   mdReferences        ::   (Map ModuleName (Set String)) -- imports+    ,   mdReferences        ::   (Map ModuleName (Set Text)) -- imports     ,   mdIdDescriptions    ::   [Descr] } deriving (Show,Typeable) @@ -197,7 +206,7 @@         deriving (Show,Read,Typeable,Eq,Ord)  data RealDescr          =   RealDescr {-        dscName'        ::   String+        dscName'        ::   Text     ,   dscMbTypeStr'   ::   Maybe ByteString     ,   dscMbModu'      ::   Maybe PackModule     ,   dscMbLocation'  ::   Maybe Location@@ -218,7 +227,7 @@ isReexported (Reexported _)     =   True isReexported _                  =   False -dscName :: Descr -> String+dscName :: Descr -> Text dscName (Reexported d)          = dscName (dsrDescr d) dscName (Real d)                = dscName' d @@ -259,9 +268,9 @@     |   DataDescr [SimpleDescr] [SimpleDescr] -- ^ first constructors, then fields     |   TypeDescr     |   NewtypeDescr SimpleDescr (Maybe SimpleDescr) -- ^ first constructors, then maybe field-    |   ClassDescr  [String] [SimpleDescr] -- ^ first super, then methods+    |   ClassDescr  [Text] [SimpleDescr] -- ^ first super, then methods     |   MethodDescr Descr -- ^ classDescr-    |   InstanceDescr [String] -- ^ binds+    |   InstanceDescr [Text] -- ^ binds     |   KeywordDescr     |   ExtensionDescr     |   ModNameDescr@@ -278,7 +287,7 @@     getDefault = Variable  data SimpleDescr = SimpleDescr {-    sdName      :: String,+    sdName      :: Text,     sdType      :: Maybe ByteString,     sdLocation  :: Maybe Location,     sdComment   :: Maybe ByteString,@@ -306,27 +315,27 @@                                 deriving (Eq, Ord,Read,Show,Typeable)  instance Show (Present PackModule) where-    showsPrec _ (Present pd)  =   showString ((packageIdentifierToString . pack) pd) . showChar ':'+    showsPrec _ (Present pd)  =   showString (T.unpack $ (packageIdentifierToString . pack) pd) . showChar ':'                                     .  showString (display (modu pd)) -parsePackModule         ::   String -> PackModule-parsePackModule str     =   let (pack',mod') = span (\c -> c /= ':') str+parsePackModule         ::   Text -> PackModule+parsePackModule str     =   let (pack',mod') = T.span (\c -> c /= ':') str                             in case packageIdentifierFromString $ pack' of-                                Nothing -> perror $ "Types>>parsePackModule: Can't parse package:" ++ str-                                Just pi'-> case simpleParse $ tail mod' of-                                            Nothing -> perror $-                                                "Types>>parsePackModule: Can't parse module:" ++ str+                                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)     where perror s      =   error $ "cannot parse PackModule from " ++ s -showPackModule :: PackModule -> String-showPackModule              = show. Present+showPackModule :: PackModule -> Text+showPackModule              = T.pack . show . Present -packageIdentifierToString :: PackageIdentifier -> String-packageIdentifierToString   = display+packageIdentifierToString :: PackageIdentifier -> Text+packageIdentifierToString   = T.pack . display -packageIdentifierFromString :: String -> Maybe PackageIdentifier-packageIdentifierFromString = simpleParse+packageIdentifierFromString :: Text -> Maybe PackageIdentifier+packageIdentifierFromString = simpleParse . T.unpack  instance Show (Present Descr) where     showsPrec _ (Present descr) =   case dscMbComment descr of@@ -338,7 +347,7 @@               c com     =   showString $ unlines                                 $ map (\(i,l) -> if i == 0 then "-- | " ++ l else "--  " ++ l)                                     $ zip [0 .. length nelines - 1] nelines-                                where nelines = nonEmptyLines (BS.unpack com)+                                where nelines = nonEmptyLines $ BS.unpack com               t         =   case dscMbTypeStr descr of                                 Just ti -> showString $ BS.unpack ti                                 Nothing -> id@@ -371,7 +380,7 @@  -- | A portion of the source, spanning one or more lines and zero or more columns. data SrcSpan = SrcSpan-    { srcSpanFilename    :: String+    { srcSpanFilename    :: FilePath     , srcSpanStartLine   :: Int     , srcSpanStartColumn :: Int     , srcSpanEndLine     :: Int@@ -380,8 +389,9 @@   deriving (Eq,Ord,Show)  data Location           =   Location {-    locationSLine       ::   Int-,   locationSCol	    ::   Int+    locationFile        ::   FilePath+,   locationSLine       ::   Int+,   locationSCol        ::   Int ,   locationELine       ::   Int ,   locationECol        ::   Int }   deriving (Show,Eq,Ord,Read,Typeable)@@ -404,11 +414,11 @@ -- | An import declaration. data ImportDecl = ImportDecl     { importLoc :: Location-    , importModule :: String   -- ^ name of the module imported.+    , importModule :: Text   -- ^ name of the module imported.     , importQualified :: Bool          -- ^ imported @qualified@?     , importSrc :: Bool                -- ^ imported with @{-\# SOURCE \#-}@?-    , importPkg :: Maybe String        -- ^ imported with explicit package name-    , importAs :: Maybe String -- ^ optional alias name in an @as@ clause.+    , importPkg :: Maybe Text        -- ^ imported with explicit package name+    , importAs :: Maybe Text -- ^ optional alias name in an @as@ clause.     , importSpecs :: Maybe ImportSpecList             -- ^ optional list of import specifications.     }@@ -446,18 +456,18 @@ -- | An import specification, representing a single explicit item imported --   (or hidden) from a module. data ImportSpec-     = IVar String                  -- ^ variable-     | IAbs String                 -- ^ @T@:+     = IVar Text                  -- ^ variable+     | IAbs Text                 -- ^ @T@:                                         --   the name of a class, datatype or type synonym.-     | IThingAll String             -- ^ @T(..)@:+     | IThingAll Text             -- ^ @T(..)@:                                         --   a class imported with all of its methods, or                                         --   a datatype imported with all of its constructors.-     | IThingWith String [String]  -- ^ @T(C_1,...,C_n)@:+     | IThingWith Text [Text]  -- ^ @T(C_1,...,C_n)@:                                         --   a class imported with some of its methods, or                                         --   a datatype imported with some of its constructors.   deriving (Eq,Ord,Read,Show) -newtype VName = VName String+newtype VName = VName Text  instance Pretty ImportSpec where     pretty (IVar name)                = pretty (VName name)@@ -467,7 +477,7 @@     	pretty name <> (parenList (map (pretty.VName) nameList))     	 instance Pretty VName  where-    pretty (VName str) = if isOperator str then PP.parens (PP.text str) else (PP.text str)+    pretty (VName t) = let str = T.unpack t in if isOperator str then PP.parens (PP.text str) else PP.text str  isOperator :: String -> Bool isOperator ('(':_)   =  False              -- (), (,) etc

@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC     -XScopedTypeVariables     -XStandaloneDeriving@@ -32,7 +33,12 @@ import Distribution.ModuleName (ModuleName)  import IDE.Core.CTypes+import Control.Applicative ((<$>))+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@@ -41,6 +47,12 @@ #endif ----------------------------------------------------------- +instance BinaryShared Text where+    put = put . T.unpack+    get = T.pack <$> get+    putShared x = putShared (x . T.pack) . T.unpack+    getShared x = T.pack <$> getShared (T.unpack <$> x)+ instance BinaryShared PackModule where     put =   putShared (\ (PM pack' modu') -> do                 (put pack')@@ -221,16 +233,18 @@                 return (SimpleDescr sdName' sdType' sdLocation' sdComment' sdExported')  instance BinaryShared Location where-    put (Location locationSLine' locationSCol' locationELine' locationECol')-        = do    put locationSLine'-                put locationSCol'-                put locationELine'-                put locationECol'-    get = do    locationSLine'       <-  get-                locationSCol'        <-  get-                locationELine'       <-  get-                locationECol'        <-  get-                return (Location locationSLine' locationSCol' locationELine' locationECol')+    put Location{..}+        = do    put locationFile+                put locationSLine+                put locationSCol+                put locationELine+                put locationECol+    get = do    locationFile        <-  get+                locationSLine       <-  get+                locationSCol        <-  get+                locationELine       <-  get+                locationECol        <-  get+                return Location{..}   instance BinaryShared ModuleName where

@@ -37,6 +37,8 @@ import IDE.Utils.FileUtils (figureOutHaddockOpts) import Control.Monad.IO.Class (MonadIO(..)) import System.IO.Strict (readFile)+import qualified Data.Text as T (pack)+import Control.Applicative ((<$>))  #if !MIN_VERSION_ghc(7,6,0) showSDoc :: DynFlags -> O.SDoc -> String@@ -73,11 +75,11 @@ transformImport dflags (L srcSpan importDecl) =     ImportDecl {         importLoc = srcSpanToLocation srcSpan,-        importModule = modName,+        importModule = T.pack modName,         importQualified = ideclQualified importDecl,         importSrc = ideclSource importDecl,-        importPkg = pkgQual,-        importAs  = impAs,+        importPkg = T.pack <$> pkgQual,+        importAs  = T.pack <$> impAs,         importSpecs = specs}     where         modName =  moduleNameString $ unLoc $ ideclName importDecl@@ -93,20 +95,20 @@  transformEntity :: DynFlags -> LIE RdrName -> Maybe ImportSpec #if MIN_VERSION_ghc(7,2,0)-transformEntity dflags (L _ (IEVar name))              = Just (IVar (showSDoc dflags (pprPrefixOcc name)))+transformEntity dflags (L _ (IEVar name))              = Just (IVar (T.pack $ showSDoc dflags (pprPrefixOcc name))) #else-transformEntity dflags (L _ (IEVar name))              = Just (IVar (showSDoc dflags (pprHsVar name)))+transformEntity dflags (L _ (IEVar name))              = Just (IVar (T.pack $ showSDoc dflags (pprHsVar name))) #endif-transformEntity dflags (L _ (IEThingAbs name))         = Just (IAbs (showRdrName dflags name))-transformEntity dflags (L _ (IEThingAll name))         = Just (IThingAll (showRdrName dflags name))	-transformEntity dflags (L _ (IEThingWith name list))   = Just (IThingWith (showRdrName dflags name)-                                                        (map (showRdrName dflags) list))	+transformEntity dflags (L _ (IEThingAbs name))         = Just (IAbs (T.pack $ showRdrName dflags name))+transformEntity dflags (L _ (IEThingAll name))         = Just (IThingAll (T.pack $ showRdrName dflags name))	+transformEntity dflags (L _ (IEThingWith name list))   = Just (IThingWith (T.pack $ showRdrName dflags name)+                                                        (map (T.pack . showRdrName dflags) list))	 transformEntity _ _                              = Nothing  #if MIN_VERSION_ghc(7,2,0) srcSpanToLocation :: SrcSpan -> Location srcSpanToLocation (RealSrcSpan span')-    =   Location (srcSpanStartLine span') (srcSpanStartCol span')+    =   Location (unpackFS $ srcSpanFile span') (srcSpanStartLine span') (srcSpanStartCol span')                  (srcSpanEndLine span') (srcSpanEndCol span') srcSpanToLocation _ = error "srcSpanToLocation: unhelpful span" @@ -122,7 +124,7 @@ srcSpanToLocation span' | not (isGoodSrcSpan span')     =   error "srcSpanToLocation: unhelpful span" srcSpanToLocation span'-    =   Location (srcSpanStartLine span') (srcSpanStartCol span')+    =   Location (unpackFS $ srcSpanFile span') (srcSpanStartLine span') (srcSpanStartCol span')                  (srcSpanEndLine span') (srcSpanEndCol span')  srcSpanStartLine' :: SrcSpan -> Int

@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XScopedTypeVariables -fno-warn-type-defaults #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-} ----------------------------------------------------------------------------- -- -- Module      :  Main@@ -40,7 +42,6 @@ import Data.Time import Control.Exception        (catch, SomeException)-import MyMissing(trim) import System.Log import System.Log.Logger(updateGlobalLogger,rootLoggerName,addHandler,debugM,infoM,errorM,     setLevel)@@ -61,6 +62,10 @@         doesDirectoryExist) import IDE.Metainfo.SourceCollectorH (PackageCollectStats(..)) import Control.Monad.IO.Class (MonadIO(..))+import qualified Data.Text as T (strip, pack, unpack)+import Data.Text (Text)+import Control.Applicative ((<$>))+import Data.Monoid ((<>))  -- -------------------------------------------------------------------- -- Command line options@@ -69,7 +74,7 @@  data Flag =    CollectSystem -             | ServerCommand (Maybe String)+             | ServerCommand (Maybe Text)              --modifiers              | Rebuild              | Sources@@ -78,8 +83,8 @@              | VersionF              | Help              | Debug-             | Verbosity String-             | LogFile String+             | Verbosity Text+             | LogFile Text              | Forever              | EndWithLast        deriving (Show,Eq)@@ -90,7 +95,7 @@ -- main functions              Option ['s'] ["system"] (NoArg CollectSystem)                 "Collects new information for installed packages"-         ,   Option ['r'] ["server"] (OptArg ServerCommand "Maybe Port")+         ,   Option ['r'] ["server"] (OptArg (ServerCommand . (T.pack <$>)) "Maybe Port")                 "Start as server."          ,   Option ['b'] ["rebuild"] (NoArg Rebuild)                 "Modifier for -s and -p: Rebuild metadata"@@ -102,9 +107,9 @@                 "Display command line options"          ,   Option ['d'] ["debug"] (NoArg Debug)                 "Write ascii pack files"-         ,   Option ['e'] ["verbosity"] (ReqArg Verbosity "Verbosity")+         ,   Option ['e'] ["verbosity"] (ReqArg (Verbosity . T.pack) "Verbosity")                 "One of DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY"-         ,   Option ['l'] ["logfile"] (ReqArg LogFile "LogFile")+         ,   Option ['l'] ["logfile"] (ReqArg (LogFile . T.pack) "LogFile")                 "File path for logging messages"          ,   Option ['f'] ["forever"] (NoArg Forever)                 "Don't end the server when last connection ends"@@ -142,7 +147,7 @@                                         _           -> Nothing) o             let verbosity    =  case verbosity' of                                     [] -> INFO-                                    h:_ -> read h+                                    h:_ -> read $ T.unpack h             let logFile'     =  catMaybes $                                     map (\x -> case x of                                         LogFile s   -> Just s@@ -152,7 +157,7 @@                                     h:_ -> Just h             updateGlobalLogger rootLoggerName (\ l -> setLevel verbosity l)             when (isJust logFile) $  do-                handler' <- fileHandler (fromJust logFile) verbosity+                handler' <- fileHandler (T.unpack $ fromJust logFile) verbosity                 updateGlobalLogger rootLoggerName (\ l -> addHandler handler' l)             infoM "leksah-server" $ "***server start"             debugM "leksah-server" $ "args: " ++ show args@@ -195,7 +200,7 @@                                         waitFor running                                         return ()                                     (Just ps:_)  -> do-                                        let port = read ps+                                        let port = read $ T.unpack ps                                         running <- serveOne Nothing (server (PortNum                                             (fromIntegral port)) newPrefs connRef threadId localServerAddr)                                         waitFor running@@ -239,7 +244,7 @@                             hPutStrLn h (show ServerOK)                             hFlush h)                         (\ (e :: SomeException) -> do-                            hPutStrLn h (show (ServerFailed (show e)))+                            hPutStrLn h (show (ServerFailed (T.pack $ show e)))                             hFlush h)                     WorkspaceCommand rebuild package path modList ->                         catch (do@@ -247,7 +252,7 @@                             hPutStrLn h (show ServerOK)                             hFlush h)                         (\ (e :: SomeException) -> do-                            hPutStrLn h (show (ServerFailed (show e)))+                            hPutStrLn h (show (ServerFailed (T.pack $ show e)))                             hFlush h)                     ParseHeaderCommand filePath ->                         catch (do@@ -255,7 +260,7 @@                             hPutStrLn h (show res)                             hFlush h)                         (\ (e :: SomeException) -> do-                            hPutStrLn h (show (ServerFailed (show e)))+                            hPutStrLn h (show (ServerFailed (T.pack $ show e)))                             hFlush h)             doCommands' prefs connRef threadId (h,n,p) @@ -294,9 +299,9 @@     appendFile reportPath (report time)     where         report time = "\n++++++++++++++++++++++++++++++\n" ++ show time ++ "\n++++++++++++++++++++++++++++++\n"-                        ++ header' time ++ summary ++ details+                        ++ header' time ++ summary ++ T.unpack details         header' _time = "\nLeksah system metadata collection "-        summary = "\nSuccess with         = " ++ packs +++        summary = "\nSuccess with         = " ++ T.unpack packs ++                   "\nPackages total       = " ++ show packagesTotal ++                   "\nPackages with source = " ++ show packagesWithSource ++                   "\nPackages retreived   = " ++ show packagesRetreived ++@@ -311,9 +316,9 @@         percentageWithSource = (fromIntegral modulesWithSource) * 100.0 /                                     (fromIntegral modulesTotal')         details              = foldr detail "" (filter (isJust . mbError) stats)-        detail stat string   = string ++ "\n" ++ packageString stat ++ " " ++ trim (fromJust (mbError stat))-        packs                = foldr (\stat string -> string ++ packageString stat ++ " ")+        detail stat string   = string <> "\n" <> packageString stat <> " " <> (T.strip . fromJust $ mbError stat)+        packs                = foldr (\stat string -> string <> packageString stat <> " ")                                         "" (take 10 (filter withSource stats))-                                        ++ if packagesWithSource > 10 then "..." else ""+                                        <> if packagesWithSource > 10 then "..." else ""  

@@ -47,12 +47,7 @@ import FastString import Name import PrelNames-#if MIN_VERSION_ghc(6,12,1) import PackageConfig (PackageConfig, mkPackageId)-#else-import PackageConfig-       (PackageConfig, mkPackageId)-#endif import TcRnTypes import Data.Char (isSpace) import qualified Data.Map as Map@@ -70,11 +65,13 @@ import TcRnMonad (initTcRnIf) import IDE.Utils.GHCUtils import Control.DeepSeq(deepseq)+import Data.Text (Text)+import qualified Data.Text as T (pack)  #if !MIN_VERSION_ghc(7,6,0)-showSDoc :: DynFlags -> SDoc -> String+showSDoc :: DynFlags -> SDoc -> Text showSDoc _ = O.showSDoc-showSDocUnqual :: DynFlags -> SDoc -> String+showSDocUnqual :: DynFlags -> SDoc -> Text showSDocUnqual _ = O.showSDocUnqual #endif @@ -147,7 +144,7 @@     -> ModuleDescr extractExportedDescrR dflags pid hidden iface =     let mid             =   (fromJust . simpleParse . moduleNameString . moduleName) (mi_module iface)-        exportedNames   =   Set.fromList+        exportedNames   =   Set.fromList . map T.pack #if MIN_VERSION_Cabal(1,11,0)                                 $ map (occNameString . nameOccName)                                     $ concatMap availNames@@ -157,7 +154,7 @@                                     $ concatMap availNames                                         $ concatMap snd (mi_exports iface) #endif-        exportedDecls   =   filter (\ ifdecl -> (occNameString $ifName ifdecl)+        exportedDecls   =   filter (\ ifdecl -> (T.pack . occNameString $ ifName ifdecl)                                                     `Set.member` exportedNames)                                                             (map snd (mi_decls iface))         ownDecls        =   concatMap (extractIdentifierDescr dflags pid [mid]) exportedDecls@@ -181,8 +178,8 @@       then []       else         let descr = RealDescr{-                    dscName'           =   unpackFS $occNameFS (ifName decl)-                ,   dscMbTypeStr'      =   Just (BS.pack $ unlines $ nonEmptyLines $ filterExtras $ showSDocUnqual dflags $ppr decl)+                    dscName'           =   T.pack . unpackFS . occNameFS $ ifName decl+                ,   dscMbTypeStr'      =   Just . BS.pack . unlines . nonEmptyLines . filterExtras . showSDocUnqual dflags $ ppr decl                 ,   dscMbModu'         =   Just (PM package (last modules))                 ,   dscMbLocation'     =   Nothing                 ,   dscMbComment'      =   Nothing@@ -246,7 +243,7 @@ #endif  extractConstructors :: DynFlags -> OccName -> [IfaceConDecl] -> [SimpleDescr]-extractConstructors dflags name decls = map (\decl -> SimpleDescr (unpackFS $occNameFS (ifConOcc decl))+extractConstructors dflags name decls = map (\decl -> SimpleDescr (T.pack . unpackFS $occNameFS (ifConOcc decl))                                                  (Just (BS.pack $ filterExtras $ showSDocUnqual dflags $                                                     pprIfaceForAllPart (ifConUnivTvs decl ++ ifConExTvs decl)                                                         (eq_ctxt decl ++ ifConCtxt decl) (pp_tau decl)))@@ -272,15 +269,15 @@ extractType :: DynFlags -> IfaceType -> Maybe ByteString extractType dflags it = Just ((BS.pack . filterExtras . showSDocUnqual dflags . ppr) it) -extractFieldNames :: OccName -> String-extractFieldNames occName' = unpackFS $occNameFS occName'+extractFieldNames :: OccName -> Text+extractFieldNames occName' = T.pack . unpackFS $occNameFS occName'  extractClassOp :: DynFlags -> IfaceClassOp -> SimpleDescr-extractClassOp dflags (IfaceClassOp occName' _dm ty) = SimpleDescr (unpackFS $occNameFS occName')+extractClassOp dflags (IfaceClassOp occName' _dm ty) = SimpleDescr (T.pack . unpackFS $occNameFS occName')                                                 (Just (BS.pack $ showSDocUnqual dflags (ppr ty)))                                                 Nothing Nothing True -extractSuperClassNames :: [IfacePredType] -> [String]+extractSuperClassNames :: [IfacePredType] -> [Text] extractSuperClassNames l = catMaybes $ map extractSuperClassName l     where #if !MIN_VERSION_ghc(7,3,0)@@ -299,12 +296,12 @@     -> [Descr] extractInstances dflags pm ifaceInst  =     let className   =   showSDocUnqual dflags $ ppr $ ifInstCls ifaceInst-        dataNames   =   map (\iftc -> showSDocUnqual dflags $ ppr iftc)+        dataNames   =   map (\iftc -> T.pack . showSDocUnqual dflags $ ppr iftc)                             $ map fromJust                                 $ filter isJust                                     $ ifInstTys ifaceInst     in [Real (RealDescr-                    {   dscName'         =   className+                    {   dscName'         =   T.pack className                     ,   dscMbTypeStr'    =   Nothing                     ,   dscMbModu'       =   Just pm                     ,   dscMbLocation'   =   Nothing@@ -313,13 +310,13 @@                     ,   dscExported'     =   False})]  -extractUsages :: DynFlags -> Usage -> Maybe (ModuleName, Set String)+extractUsages :: DynFlags -> Usage -> Maybe (ModuleName, Set Text) extractUsages _ (UsagePackageModule {usg_mod = usg_mod'}) =     let name    =   (fromJust . simpleParse . moduleNameString) (moduleName usg_mod')     in Just (name, Set.fromList []) extractUsages dflags (UsageHomeModule {usg_mod_name = usg_mod_name', usg_entities = usg_entities'}) =     let name    =   (fromJust . simpleParse . moduleNameString) usg_mod_name'-        ids     =   map (showSDocUnqual dflags . ppr . fst) usg_entities'+        ids     =   map (T.pack . showSDocUnqual dflags . ppr . fst) usg_entities'     in Just (name, Set.fromList ids) #if MIN_VERSION_ghc(7,4,0) extractUsages _ (UsageFile _ _) = Nothing

@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XScopedTypeVariables -fno-warn-type-defaults #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Metainfo.PackageCollector@@ -58,6 +59,9 @@ import Control.Monad.IO.Class (MonadIO, MonadIO(..)) import qualified Control.Exception as E (SomeException, catch) import IDE.Utils.Tool (runTool')+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack)+import Data.Text (Text)  collectPackage :: Bool -> Prefs -> Int -> (PackageConfig,Int) -> IO PackageCollectStats collectPackage writeAscii prefs numPackages (packageConfig, packageIndex) = do@@ -77,11 +81,11 @@                     success <- retrieve packageName                     if success                         then do-                            debugM "leksah-server" $ "collectPackage: retreived = " ++ packageName+                            debugM "leksah-server" . T.unpack $ "collectPackage: retreived = " <> packageName                             liftIO $ writePackagePath (dropFileName fpSource) packageName                             return (stat {withSource=True, retrieved= True, mbError=Nothing})                         else do-                            debugM "leksah-server" $ "collectPackage: Can't retreive = " ++ packageName+                            debugM "leksah-server" . T.unpack $ "collectPackage: Can't retreive = " <> packageName                             runCabalConfigure fpSource                             packageDescrHi <- collectPackageFromHI packageConfig                             mbPackageDescrPair <- packageFromSource fpSource packageConfig@@ -104,7 +108,7 @@                                 success  <- retrieve packageName                                 if success                                     then do-                                        debugM "leksah-server" $ "collectPackage: retreived = " ++ packageName+                                        debugM "leksah-server" . T.unpack $ "collectPackage: retreived = " <> packageName                                         liftIO $ writePackagePath (dropFileName fpSource) packageName                                         return (stat {withSource=True, retrieved= True, mbError=Nothing})                                     else do@@ -123,13 +127,13 @@                                     writeExtractedPackage False packageDescrHi                                     return bstat{modulesTotal = Just (length (pdModules packageDescrHi))}     where-        retrieve :: String -> IO Bool+        retrieve :: Text -> IO Bool         retrieve packString = do             collectorPath   <- liftIO $ getCollectorPath             setCurrentDirectory collectorPath-            let fullUrl  = retrieveURL prefs ++ "/metadata-" ++ leksahVersion ++ "/" ++ packString ++ leksahMetadataSystemFileExtension-                filePath = collectorPath </> packString <.> leksahMetadataSystemFileExtension-            debugM "leksah-server" $ "collectPackage: before retreiving = " ++ fullUrl+            let fullUrl  = T.unpack (retrieveURL prefs) <> "/metadata-" <> leksahVersion <> "/" <> T.unpack packString <> leksahMetadataSystemFileExtension+                filePath = collectorPath </> T.unpack packString <.> leksahMetadataSystemFileExtension+            debugM "leksah-server" $ "collectPackage: before retreiving = " <> fullUrl #if defined(USE_LIBCURL)             E.catch (do                 (code, string) <- curlGetString_ fullUrl []@@ -143,7 +147,7 @@ #endif                 (\(e :: SomeException) ->                     debugM "leksah-server" $ "collectPackage: Error when calling wget " ++ show e)-            debugM "leksah-server" $ "collectPackage: after retreiving = " ++ packString -- ++ " result = " ++ res+            debugM "leksah-server" . T.unpack $ "collectPackage: after retreiving = " <> packString -- ++ " result = " ++ res             exist <- doesFileExist filePath             return exist         writeMerged packageDescrS packageDescrHi fpSource packageName = do@@ -161,16 +165,16 @@ writeExtractedPackage :: MonadIO m => Bool -> PackageDescr -> m () writeExtractedPackage writeAscii pd = do     collectorPath   <- liftIO $ getCollectorPath-    let filePath    =  collectorPath </> packageIdentifierToString (pdPackage pd) <.>+    let filePath    =  collectorPath </> T.unpack (packageIdentifierToString $ pdPackage pd) <.>                             leksahMetadataSystemFileExtension     if writeAscii         then liftIO $ writeFile (filePath ++ "dpg") (show pd)         else liftIO $ encodeFileSer filePath (metadataVersion, pd) -writePackagePath :: MonadIO m => FilePath -> String -> m ()+writePackagePath :: MonadIO m => FilePath -> Text -> m () writePackagePath fp packageName = do     collectorPath   <- liftIO $ getCollectorPath-    let filePath    =  collectorPath </> packageName <.> leksahMetadataPathFileExtension+    let filePath    =  collectorPath </> T.unpack packageName <.> leksahMetadataPathFileExtension     liftIO $ writeFile filePath fp  --------------Merging of .hi and .hs parsing / parsing and typechecking results@@ -205,7 +209,7 @@ mergeDescrs :: [Descr] -> [Descr] -> [Descr] mergeDescrs hiList srcList =  concatMap mergeIt allNames     where-        mergeIt :: String -> [Descr]+        mergeIt :: Text -> [Descr]         mergeIt pm = case (Map.lookup pm hiDict, Map.lookup pm srcDict) of                         (Just mdhi, Nothing) -> mdhi                         (Nothing, Just mdsrc) -> mdsrc@@ -271,7 +275,7 @@ mergeSimpleDescrs :: [SimpleDescr] -> [SimpleDescr] -> [SimpleDescr] mergeSimpleDescrs hiList srcList =  map mergeIt allNames     where-        mergeIt :: String -> SimpleDescr+        mergeIt :: Text -> SimpleDescr         mergeIt pm = case mergeMbDescr (Map.lookup pm hiDict) (Map.lookup pm srcDict) of                         Just mdhi -> mdhi                         Nothing   -> error "Collector>>mergeSimpleDescrs: impossible"

@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XScopedTypeVariables -XBangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Metainfo.SourceCollectorH@@ -24,7 +25,7 @@ import IDE.Core.CTypes        (getThisPackage, PackageDescr(..), TypeDescr(..), RealDescr(..),         Descr(..), ModuleDescr(..), PackModule(..), SimpleDescr(..),-        packageIdentifierToString)+        packageIdentifierToString, Location(..), RealDescr(..))  #ifdef MIN_VERSION_haddock_leksah import Haddock.Types@@ -40,20 +41,14 @@ #else import InstEnv (Instance(..)) #endif-import MyMissing+import MyMissing (forceJust) import Data.Map (Map) import qualified Data.Map as Map (empty) -import Data.List (nub)+import Data.List (nub, isSuffixOf) import qualified Data.ByteString.Char8 as BS (pack)-#if MIN_VERSION_ghc(6,12,1) import IDE.Metainfo.WorkspaceCollector        (srcSpanToLocation, uncommentDecl, uncommentData, printHsDoc, sortByLoc)-#else-import IDE.Metainfo.WorkspaceCollector-       (srcSpanToLocation, uncommentDecl, uncommentData, sortByLoc)-#endif- import PackageConfig (PackageConfig) import Distribution.Verbosity (verbose) import qualified Distribution.InstalledPackageInfo as IPI@@ -61,7 +56,7 @@ import IDE.Metainfo.SourceDB (sourceForPackage, getSourcesMap) import MonadUtils (liftIO) import System.Directory (setCurrentDirectory, doesDirectoryExist,createDirectory)-import System.FilePath ((<.>), dropFileName, (</>))+import System.FilePath ((<.>), dropFileName, (</>), splitDirectories, dropExtension) import Data.Maybe(mapMaybe) import IDE.Utils.GHCUtils (inGhcIO) import qualified Control.Exception as NewException (SomeException, catch)@@ -70,17 +65,21 @@ import IDE.Utils.FileUtils (figureOutGhcOpts, myCanonicalizePath) import Distribution.Package(PackageIdentifier) import GHC hiding(Id,Failed,Succeeded,ModuleName)+import Distribution.ModuleName (components) import System.Log.Logger (warningM, debugM) import Control.DeepSeq (deepseq) import Data.ByteString.Char8 (ByteString) #if MIN_VERSION_ghc(7,6,0)-import Outputable hiding(trace)+import Outputable hiding(trace, (<>)) #else-import Outputable hiding(trace, showSDoc, showSDocUnqual)+import Outputable hiding(trace, (<>), showSDoc, showSDocUnqual) import qualified Outputable as O #endif import GHC.Show(showSpace) import Name+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack)+import Data.Monoid ((<>))  #ifdef MIN_VERSION_haddock_leksah #else@@ -93,16 +92,12 @@ isEmptyDoc DocEmpty  = True isEmptyDoc _         = False -#if MIN_VERSION_ghc(6,12,1) type MyLDocDecl = LDocDecl-#else-type MyLDocDecl = LDocDecl Name-#endif  #if !MIN_VERSION_ghc(7,6,0)-showSDoc :: DynFlags -> SDoc -> String+showSDoc :: DynFlags -> SDoc -> Text showSDoc _ = O.showSDoc-showSDocUnqual :: DynFlags -> SDoc -> String+showSDocUnqual :: DynFlags -> SDoc -> Text showSDocUnqual _ = O.showSDocUnqual #endif @@ -110,13 +105,13 @@ show' dflags = showSDoc dflags . ppr  data PackageCollectStats = PackageCollectStats {-    packageString       :: String,+    packageString       :: Text,     modulesTotal        :: Maybe Int,     withSource          :: Bool,     retrieved           :: Bool,-    mbError             :: Maybe String}+    mbError             :: Maybe Text} -findSourceForPackage :: Prefs -> PackageConfig -> IO (Either String FilePath)+findSourceForPackage :: Prefs -> PackageConfig -> IO (Either Text FilePath) findSourceForPackage prefs packageConfig = do     sourceMap <- liftIO $ getSourcesMap prefs     case sourceForPackage (getThisPackage packageConfig) sourceMap of@@ -130,12 +125,13 @@                     unless exists $ createDirectory fpUnpack                     setCurrentDirectory fpUnpack                     runTool' "cabal" (["unpack",packageName]) Nothing-                    success <- doesDirectoryExist (fpUnpack </> packageName)+                    success <- doesDirectoryExist (fpUnpack </> packageName')                     if not success                         then return (Left "Failed to download and unpack source")-                        else return (Right (fpUnpack </> packageName </>  takeWhile (/= '-') packageName <.> "cabal"))+                        else return (Right (fpUnpack </> packageName' </>  takeWhile (/= '-') packageName' <.> "cabal"))     where         packageName = packageIdentifierToString (getThisPackage packageConfig)+        packageName' = T.unpack packageName   packageFromSource :: FilePath -> PackageConfig -> IO (Maybe PackageDescr, PackageCollectStats)@@ -151,7 +147,7 @@         handler (e :: NewException.SomeException) = do             warningM "leksah-server" ("Ghc failed to process: " ++ show e)             return (Nothing, PackageCollectStats packageName Nothing False False-                                            (Just ("Ghc failed to process: " ++ show e)))+                                            (Just ("Ghc failed to process: " <> T.pack (show e))))         inner ghcFlags = inGhcIO ghcFlags [Opt_Haddock] $ \ dflags -> do #if MIN_VERSION_haddock(2,8,0)             (interfaces,_) <- processModules verbose (exportedMods ++ hiddenMods) [] []@@ -183,9 +179,17 @@     ,   mdReferences        =   imports     ,   mdIdDescriptions    =   descrs}     where-        filepath   = ifaceOrigFilename interface+        -- ifaceOrigFilename points at the hs output file (not chs file)+        -- So if possible we look up one of the things in the module and+        -- get the file it is located in.+        filepath   = head $+            [locationFile loc | Real RealDescr{dscMbLocation' = Just loc,+                dscMbModu' = Just dscMod} <- descrs, dscMod == PM pid modName,+                filenameMatchesModule (locationFile loc)]+            ++ [ifaceOrigFilename interface]         modName    = forceJust ((simpleParse . moduleNameString . moduleName . ifaceMod) interface)                         "Can't parse module name"+        filenameMatchesModule fn = components modName `isSuffixOf` splitDirectories (dropExtension fn)         descrs     = extractDescrs dflags (PM pid modName)                         (ifaceDeclMap interface) (ifaceExportItems interface)                         (ifaceInstances interface) [] --(ifaceLocals interface)@@ -202,7 +206,6 @@ #if MIN_VERSION_ghc(7,4,1) type DeclInfo = [LHsDecl Name] #endif-#if MIN_VERSION_ghc(6,12,1) #if MIN_VERSION_ghc(7,6,0) extractDescrs :: DynFlags -> PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [ClsInst] -> [Name] -> [Descr] #else@@ -218,18 +221,6 @@         toDeclInfo (ExportGroup _ _ _)                 = Nothing         toDeclInfo (ExportDoc _)                       = Nothing         toDeclInfo (ExportModule _)                    = Nothing-#else-extractDescrs :: DynFlags -> PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [Instance] -> [Name] -> [Descr]-extractDescrs dflags pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =-        transformToDescrs dflags pm exportedDeclInfo ++ map (toDescrInst dflags pm) ifaceInstances'-    where-        exportedDeclInfo                               =  mapMaybe toDeclInfo  ifaceExportItems'-        toDeclInfo (ExportDecl decl mbDoc subDocs _)   = Just(decl,mbDoc,subDocs)-        toDeclInfo (ExportNoDecl _ _)                  = Nothing-        toDeclInfo (ExportGroup _ _ _)                 = Nothing-        toDeclInfo (ExportDoc _)                       = Nothing-        toDeclInfo (ExportModule _)                    = Nothing-#endif  transformToDescrs :: DynFlags -> PackModule -> [(LHsDecl Name, Maybe NDoc, [(Name, Maybe NDoc)])] -> [Descr] transformToDescrs dflags pm = concatMap transformToDescr@@ -240,8 +231,8 @@     transformToDescr ((L loc (SigD (TypeSig name typ))), mbComment,_subCommentList) = #endif         [Real $ RealDescr {-        dscName'        =   getOccString (unLoc name)-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr typ))+        dscName'        =   T.pack . getOccString $ unLoc name+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -253,8 +244,8 @@ #if MIN_VERSION_ghc(7,6,0)     transformToDescr ((L loc (TyClD typ@(ForeignType {tcdLName = lid}))), mbComment,_sigList) =         [Real $ RealDescr {-        dscName'        =   getOccString (unLoc lid)-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr typ))+        dscName'        =   T.pack . getOccString $ unLoc lid+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -267,8 +258,8 @@     transformToDescr ((L loc (TyClD typ@(TyFamily {tcdLName = lid}))), mbComment,_sigList) = #endif         [Real $ RealDescr {-        dscName'        =   getOccString (unLoc lid)-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr typ))+        dscName'        =   T.pack . getOccString $ unLoc lid+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -284,8 +275,8 @@     transformToDescr ((L loc (TyClD typ@(TySynonym lid _ _ _ ))), mbComment, _subCommentList) = #endif         [Real $ RealDescr {-        dscName'        =   getOccString (unLoc lid)-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr typ))+        dscName'        =   T.pack . getOccString $ unLoc lid+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -300,8 +291,8 @@     transformToDescr ((L loc (TyClD typ@(TyData DataType _ lid _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) = #endif         [Real $ RealDescr {-        dscName'        =   name-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))+        dscName'        =   T.pack name+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags . ppr $ uncommentData typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -319,7 +310,7 @@     transformToDescr ((L loc (TyClD typ@(TyData NewType _ tcdLName' _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) =         [Real $ RealDescr {         dscName'        =   name-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags . ppr $ uncommentData typ     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -339,8 +330,8 @@      transformToDescr ((L loc (TyClD cl@(ClassDecl{tcdLName=tcdLName', tcdSigs=tcdSigs', tcdDocs=docs}))), mbComment,_subCommentList) =         [Real $ RealDescr {-        dscName'        =   getOccString (unLoc tcdLName')-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr cl{tcdMeths = emptyLHsBinds}))+        dscName'        =   T.pack . getOccString $ unLoc tcdLName'+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr cl{tcdMeths = emptyLHsBinds}     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment dflags mbComment []@@ -360,12 +351,12 @@ toDescrInst dflags pm inst@(Instance is_cls' _is_tcs _is_tvs is_tys' _is_dfun _is_flag) = #endif         Real $ RealDescr {-        dscName'        =   getOccString is_cls'-    ,   dscMbTypeStr'   =   Just (BS.pack (showSDocUnqual dflags $ppr inst))+        dscName'        =   T.pack $ getOccString is_cls'+    ,   dscMbTypeStr'   =   Just . BS.pack . showSDocUnqual dflags $ ppr inst     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation (getSrcSpan inst)     ,   dscMbComment'   =   Nothing-    ,   dscTypeHint'    =   InstanceDescr (map (showSDocUnqual dflags . ppr) is_tys')+    ,   dscTypeHint'    =   InstanceDescr (map (T.pack . showSDocUnqual dflags . ppr) is_tys')     ,   dscExported'    =   True}  extractMethods :: DynFlags -> [LSig Name] -> [MyLDocDecl] -> [SimpleDescr]@@ -380,8 +371,8 @@ extractMethod dflags ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) = #endif     Just $ SimpleDescr-        (getOccString (unLoc name))-        (Just (BS.pack (showSDocUnqual dflags $ ppr ts)))+        (T.pack . getOccString $ unLoc name)+        (Just . BS.pack . showSDocUnqual dflags $ ppr ts)         (srcSpanToLocation loc)         (toComment dflags mbDoc [])         True@@ -390,12 +381,12 @@ extractConstructor :: DynFlags -> LConDecl Name -> SimpleDescr extractConstructor dflags decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =     SimpleDescr-        (getOccString (unLoc name))-        (Just (BS.pack (showSDocUnqual dflags $ppr (uncommentDecl decl))))+        (T.pack . getOccString $ unLoc name)+        (Just . BS.pack . showSDocUnqual dflags . ppr $uncommentDecl decl)         (srcSpanToLocation loc)         (case doc of             Nothing -> Nothing-            Just (L _ d) -> Just (BS.pack (printHsDoc d)))+            Just (L _ d) -> Just . BS.pack . T.unpack $ printHsDoc d)         True  extractRecordFields :: DynFlags -> LConDecl Name -> [SimpleDescr]@@ -404,18 +395,18 @@     where     extractRecordFields' _field@(ConDeclField (L loc name) typ doc) =         SimpleDescr-            (getOccString name)+            (T.pack $ getOccString name)             (Just (BS.pack (showSDocUnqual dflags $ ppr typ)))             (srcSpanToLocation loc)             (case doc of                 Nothing -> Nothing-                Just (L _ d) -> Just (BS.pack (printHsDoc d)))+                Just (L _ d) -> Just . BS.pack . T.unpack $ printHsDoc d)             True extractRecordFields _ _ = []  toComment :: DynFlags -> Maybe NDoc -> [NDoc] -> Maybe ByteString-toComment dflags (Just c) _    =  Just (BS.pack (printHsDoc' dflags c))-toComment dflags Nothing (c:_) =  Just (BS.pack (printHsDoc' dflags c))+toComment dflags (Just c) _    =  Just . BS.pack . T.unpack $ printHsDoc' dflags c+toComment dflags Nothing (c:_) =  Just . BS.pack . T.unpack $ printHsDoc' dflags c toComment _ Nothing []         =  Nothing  @@ -427,8 +418,8 @@     =   addLocationAndComment (l,st) (unLoc lid) loc mbComment' [Class] [] --} -printHsDoc' :: DynFlags -> HsDoc Name  -> String-printHsDoc' dflags d = show (PPDoc dflags d)+printHsDoc' :: DynFlags -> HsDoc Name  -> Text+printHsDoc' dflags d = T.pack . show $ PPDoc dflags d  data PPDoc alpha = PPDoc DynFlags (HsDoc alpha) 

@@ -1,4 +1,4 @@-+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Metainfo.SourceDB@@ -62,6 +62,10 @@ import System.FilePath        (takeDirectory, (</>), takeFileName) import System.Directory (doesDirectoryExist)+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack)+import Control.Applicative ((<$>))+import Data.Monoid ((<>))  -- --------------------------------------------------------------------- -- Function to map packages to file paths@@ -106,16 +110,16 @@     filePath        <-  getConfigFilePathForSave standardSourcesFilename     writeFile filePath  (PP.render (showSourceForPackageDB pdToFiles)) -showSourceForPackageDB  :: Map String [FilePath] -> PP.Doc+showSourceForPackageDB  :: Map Text [FilePath] -> PP.Doc showSourceForPackageDB aMap = PP.vcat (map showIt (Map.toList aMap))     where-    showIt :: (String,[FilePath]) -> PP.Doc+    showIt :: (Text,[FilePath]) -> PP.Doc     showIt (pd,list) =  (foldl' (\l n -> l PP.$$ (PP.text $ show n)) label list)                              PP.<>  PP.char '\n'-        where label  =  PP.text pd PP.<> PP.colon+        where label  =  PP.text (T.unpack pd) PP.<> PP.colon  -- Strict version-parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a) parseFromFile p f = do     input <- S.readFile f     return $ parse p f input@@ -155,8 +159,8 @@ whiteSpace :: CharParser st () whiteSpace = P.whiteSpace lexer -symbol :: String -> CharParser st String-symbol = P.symbol lexer+symbol :: Text -> CharParser st Text+symbol = (T.pack <$>) . P.symbol lexer . T.unpack  sourceForPackageParser :: CharParser () (Map PackageIdentifier [FilePath]) sourceForPackageParser = do@@ -181,7 +185,7 @@     whiteSpace     str <- many (noneOf ":")     char ':'-    return (packageIdentifierFromString str))+    return (packageIdentifierFromString (T.pack str)))     <?> "packageDescriptionParser"  filePathParser :: CharParser () FilePath@@ -193,7 +197,7 @@     return (str))     <?> "filePathParser" -parseCabal :: FilePath -> IO (Maybe String)+parseCabal :: FilePath -> IO (Maybe Text) parseCabal fn = do     --putStrLn $ "Now parsing minimal " ++ fn     res   <- parseFromFile cabalMinimalParser fn@@ -202,39 +206,39 @@             errorM "leksah-server" $"Error reading cabal file " ++ show fn ++ " " ++ show pe             return Nothing         Right r ->  do-            debugM "leksah-server" r+            debugM "leksah-server" (T.unpack r)             return (Just r)  -cabalMinimalParser :: CharParser () String+cabalMinimalParser :: CharParser () Text cabalMinimalParser = do     r1 <- cabalMinimalP     r2 <- cabalMinimalP     case r1 of         Left v -> do             case r2 of-                Right n -> return (n ++ "-" ++ v)+                Right n -> return (n <> "-" <> v)                 Left _ -> unexpected "Illegal cabal"         Right n -> do             case r2 of-                Left v -> return (n ++ "-" ++ v)+                Left v -> return (n <> "-" <> v)                 Right _ -> unexpected "Illegal cabal" -cabalMinimalP :: CharParser () (Either String String)+cabalMinimalP :: CharParser () (Either Text Text) cabalMinimalP =     do  try $(symbol "name:" <|> symbol "Name:")         whiteSpace         name       <-  (many $noneOf " \n")         (many $noneOf "\n")         char '\n'-        return (Right name)+        return . Right $ T.pack name     <|> do             try $(symbol "version:" <|> symbol "Version:")             whiteSpace             versionString    <-  (many $noneOf " \n")             (many $noneOf "\n")             char '\n'-            return (Left versionString)+            return . Left $ T.pack versionString     <|> do             many $noneOf "\n"             char '\n'

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables, PatternGuards, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Metainfo.WorkspaceCollector@@ -36,9 +36,9 @@ import HscTypes hiding (liftIO) #endif #if MIN_VERSION_ghc(7,6,0)-import Outputable hiding(trace)+import Outputable hiding(trace, (<>)) #else-import Outputable hiding(trace, showSDoc, showSDocUnqual)+import Outputable hiding(trace, (<>), showSDoc, showSDocUnqual) import qualified Outputable as O #endif import ErrUtils@@ -57,7 +57,7 @@ import Data.ByteString.Char8 (ByteString) import DriverPipeline (preprocess) import StringBuffer(hGetStringBuffer)-import Data.List(partition,sortBy,nub,find,intercalate)+import Data.List(partition,sortBy,nub,find) import Data.Ord(comparing) import GHC.Exception #if !MIN_VERSION_ghc(7,6,0)@@ -74,55 +74,46 @@ import PrelNames import System.Log.Logger import Control.DeepSeq (deepseq)-#if MIN_VERSION_ghc(6,12,1) import FastString(mkFastString,appendFS,nullFS,unpackFS) import Control.Monad.IO.Class (MonadIO, MonadIO(..)) import Control.Monad (when)-#else-import GHC.Show(showSpace)-#endif import Control.Exception as E+import Control.Applicative ((<$>), (<|>))+import Debug.Trace (trace)+import Data.Text (Text)+import qualified Data.Text as T (intercalate, words, unpack, pack)+import Data.Monoid ((<>))  type NDecl = LHsDecl RdrName myDocEmpty :: NDoc myDocAppend :: NDoc -> NDoc -> NDoc isEmptyDoc :: NDoc -> Bool -#if MIN_VERSION_ghc(6,12,1) type NDoc  = HsDocString type MyLDocDecl = LDocDecl  myDocEmpty=HsDocString(mkFastString "") myDocAppend (HsDocString l) (HsDocString r) = HsDocString (appendFS l r) isEmptyDoc (HsDocString fs) = nullFS fs-#else-type NDoc       = HsDoc RdrName-type MyLDocDecl = LDocDecl RdrName -myDocEmpty           = DocEmpty-myDocAppend          = docAppend-isEmptyDoc DocEmpty  = True-isEmptyDoc _         = False--#endif type NSig  = Located (Sig RdrName)  #if !MIN_VERSION_ghc(7,6,0)-showSDoc :: DynFlags -> SDoc -> String+showSDoc :: DynFlags -> SDoc -> Text showSDoc _ = O.showSDoc-showSDocUnqual :: DynFlags -> SDoc -> String+showSDocUnqual :: DynFlags -> SDoc -> Text showSDocUnqual _ = O.showSDocUnqual #endif -showRdrName :: DynFlags -> RdrName -> String-showRdrName dflags r = showSDoc dflags (ppr r)+showRdrName :: DynFlags -> RdrName -> Text+showRdrName dflags r = T.pack . showSDoc dflags $ ppr r  -- | Test-collectWorkspace :: PackageIdentifier ->  [(String,FilePath)] -> Bool -> Bool -> FilePath -> IO()+collectWorkspace :: PackageIdentifier ->  [(Text,FilePath)] -> Bool -> Bool -> FilePath -> IO() collectWorkspace packId moduleList forceRebuild writeAscii dir = do     debugM "leksah-server" $ "collectWorkspace called with modules " ++ show moduleList ++ " in folder " ++ dir     collectorPath <- liftIO $ getCollectorPath-    let packageCollectorPath = collectorPath </> packageIdentifierToString packId+    let packageCollectorPath = collectorPath </> T.unpack (packageIdentifierToString packId)     when forceRebuild $ do         exists <- doesDirectoryExist packageCollectorPath         when exists $ removeDirectoryRecursive packageCollectorPath@@ -136,12 +127,12 @@     mapM_ (collectModule packageCollectorPath writeAscii packId opts1) moduleList     debugM "leksah-server" $ "after collect modules" -collectModule :: FilePath -> Bool -> PackageIdentifier -> [String] -> (String,FilePath) -> IO()+collectModule :: FilePath -> Bool -> PackageIdentifier -> [Text] -> (Text,FilePath) -> IO() collectModule collectorPackagePath writeAscii packId opts (modId,sourcePath) = do     existCollectorFile <- doesFileExist collectorModulePath     existSourceFile    <- doesFileExist sourcePath     case mbModuleName of-        Nothing -> errorM "leksah-server" ("Can't parse module name " ++ modId)+        Nothing -> errorM "leksah-server" (T.unpack $ "Can't parse module name " <> modId)         Just moduleName' ->             if existSourceFile             then do@@ -156,11 +147,11 @@                             else return ()             else errorM "leksah-server" ("source file not found " ++ sourcePath)     where-        collectorModulePath = collectorPackagePath </> modId <.> leksahMetadataWorkspaceFileExtension-        mbModuleName = simpleParse modId+        collectorModulePath = collectorPackagePath </> T.unpack modId <.> leksahMetadataWorkspaceFileExtension+        mbModuleName = simpleParse $ T.unpack modId  -collectModule' :: FilePath -> FilePath -> Bool -> PackageIdentifier -> [String] -> ModuleName -> IO()+collectModule' :: FilePath -> FilePath -> Bool -> PackageIdentifier -> [Text] -> ModuleName -> IO() collectModule' sourcePath destPath writeAscii packId opts moduleName' = gcatch (     inGhcIO (opts++["-cpp"]) [Opt_Haddock] $ \ dynFlags -> do         session         <-  getSession@@ -218,12 +209,15 @@ extractModDescr :: DynFlags -> PackageIdentifier -> ModuleName -> FilePath -> HsModule RdrName -> ModuleDescr extractModDescr dflags packId moduleName' sourcePath hsMod = ModuleDescr {         mdModuleId          =   PM packId moduleName'-    ,   mdMbSourcePath      =   Just sourcePath+    ,   mdMbSourcePath      =   trace ("extractModDescr " ++ (show . modFile $ hsmodName hsMod)) $ modFile $ hsmodName hsMod     ,   mdReferences        =   Map.empty -- imports     ,   mdIdDescriptions    =   descrs'}     where         descrs = extractDescrs dflags (PM packId moduleName') (hsmodDecls hsMod)         descrs' = fixExports dflags (hsmodExports hsMod) descrs+        modFile (Just (L loc _)) =+            (locationFile <$> srcSpanToLocation loc) <|> Just sourcePath+        modFile _ = Just sourcePath  ----------------------------------------------------------------------------------- -- Add exported hint@@ -562,13 +556,13 @@                      ClsInstD t -> ppr t                      DataFamInstD t -> ppr t                      TyFamInstD t -> ppr t-            (instn,nameI,other) =   case words (showSDocUnqual dflags typp) of+            (instn,nameI,other) =   case T.words . T.pack $ showSDocUnqual dflags typp of                                         instn':nameI':tl -> (instn',nameI',takeWhile (/= "where") tl)                                         _ -> ("","",[])         in             [Real $ RealDescr {-            dscName'        =   instn ++ " " ++ nameI-        ,   dscMbTypeStr'   =   Just (BS.pack (instn ++ " " ++ nameI ++ " " ++ (intercalate " " other)))+            dscName'        =   instn <> " " <> nameI+        ,   dscMbTypeStr'   =   Just (BS.pack . T.unpack $ instn <> " " <> nameI <> " " <> (T.intercalate " " other))         ,   dscMbModu'      =   Just pm         ,   dscMbLocation'  =   srcSpanToLocation loc         ,   dscMbComment'   =   toComment mbComment []@@ -649,18 +643,18 @@                                         Just d -> dscMbTypeStr d}         addType _ d                     = d -extractDeriving :: OutputableBndr alpha => DynFlags -> PackModule -> String -> LHsType alpha -> Descr+extractDeriving :: OutputableBndr alpha => DynFlags -> PackModule -> Text -> LHsType alpha -> Descr extractDeriving dflags pm name (L loc typ) =         Real $ RealDescr {         dscName'        =   className-    ,   dscMbTypeStr'   =   Just (BS.pack ("instance " ++ (className ++ " " ++ name)))+    ,   dscMbTypeStr'   =   Just (BS.pack . T.unpack $ "instance " <> className <> " " <> name)     ,   dscMbModu'      =   Just pm     ,   dscMbLocation'  =   srcSpanToLocation loc     ,   dscMbComment'   =   toComment (Nothing :: Maybe NDoc) []-    ,   dscTypeHint'    =   InstanceDescr (words name)+    ,   dscTypeHint'    =   InstanceDescr (T.words name)     ,   dscExported'    =   True}         where-        className       =   showSDocUnqual dflags $ ppr typ+        className       =   T.pack . showSDocUnqual dflags $ ppr typ  extractMethods :: DynFlags -> [LSig RdrName] -> [MyLDocDecl] -> [SimpleDescr] extractMethods dflags sigs docs =@@ -674,8 +668,8 @@ extractMethod dflags ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) = #endif     Just $ SimpleDescr-        ((showSDoc dflags . ppr) (unLoc name))-        (Just (BS.pack (showSDocUnqual dflags $ ppr ts)))+        (T.pack . showSDoc dflags . ppr $ unLoc name)+        (Just . BS.pack . showSDocUnqual dflags $ ppr ts)         (srcSpanToLocation loc)         (toComment mbDoc [])         True@@ -684,12 +678,12 @@ extractConstructor :: DynFlags -> Located (ConDecl RdrName) -> SimpleDescr extractConstructor dflags decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =     SimpleDescr-        ((showSDoc dflags . ppr) (unLoc name))-        (Just (BS.pack (showSDocUnqual dflags $ppr (uncommentDecl decl))))+        (T.pack . showSDoc dflags . ppr $ unLoc name)+        (Just . BS.pack . showSDocUnqual dflags . ppr $ uncommentDecl decl)         (srcSpanToLocation loc)         (case doc of             Nothing -> Nothing-            Just (L _ d) -> Just (BS.pack (printHsDoc d)))+            Just (L _ d) -> Just . BS.pack . T.unpack $ printHsDoc d)         True  extractRecordFields :: DynFlags -> Located (ConDecl RdrName) -> [SimpleDescr]@@ -698,12 +692,12 @@     where     extractRecordFields' _field@(ConDeclField (L loc name) typ doc) =         SimpleDescr-            ((showSDoc dflags . ppr) name)-            (Just (BS.pack (showSDocUnqual dflags $ ppr typ)))+            (T.pack . showSDoc dflags $ ppr name)+            (Just . BS.pack . showSDocUnqual dflags $ ppr typ)             (srcSpanToLocation loc)             (case doc of                 Nothing -> Nothing-                Just (L _ d) -> Just (BS.pack (printHsDoc d)))+                Just (L _ d) -> Just . BS.pack . T.unpack $ printHsDoc d)             True extractRecordFields _ _ = [] @@ -719,20 +713,20 @@ srcSpanToLocation :: SrcSpan -> Maybe Location #if MIN_VERSION_ghc(7,2,0) srcSpanToLocation (RealSrcSpan span')-    =   Just (Location (srcSpanStartLine span') (srcSpanStartCol span')+    =   Just (Location (unpackFS $ srcSpanFile span') (srcSpanStartLine span') (srcSpanStartCol span')                  (srcSpanEndLine span') (srcSpanEndCol span')) srcSpanToLocation _ = Nothing #else srcSpanToLocation span' | not (isGoodSrcSpan span')     =   Nothing srcSpanToLocation span'-    =   Just (Location (srcSpanStartLine span') (srcSpanStartCol span')+    =   Just (Location (unpackFS $ srcSpanFile span') (srcSpanStartLine span') (srcSpanStartCol span')                  (srcSpanEndLine span') (srcSpanEndCol span')) #endif  toComment :: Maybe (NDoc) -> [NDoc] -> Maybe ByteString-toComment (Just c) _    =  Just (BS.pack (printHsDoc c))-toComment Nothing (c:_) =  Just (BS.pack (printHsDoc c))+toComment (Just c) _    =  Just . BS.pack . T.unpack $ printHsDoc c+toComment Nothing (c:_) =  Just . BS.pack . T.unpack $ printHsDoc c toComment Nothing []    =  Nothing  @@ -743,42 +737,9 @@ collectParseInfoForDecl (l,st) ((Just (L loc (TyClD (ClassDecl _ lid _ _ _ _ _ _ )))), mbComment')     =   addLocationAndComment (l,st) (unLoc lid) loc mbComment' [Class] [] --}-#if MIN_VERSION_ghc(6,12,1)-printHsDoc :: NDoc  -> String-printHsDoc (HsDocString fs) = unpackFS fs--#else-printHsDoc :: NDoc  -> String-printHsDoc d = show (PPDoc d)---- Okay, I need to reconstruct the document comments, but for now:---instance Outputable (DocDecl name) where---  ppr _ = text "<**>"---newtype PPDoc alpha = PPDoc (HsDoc alpha)+printHsDoc :: NDoc  -> Text+printHsDoc (HsDocString fs) = T.pack $ unpackFS fs -instance Outputable alpha => Show (PPDoc alpha)  where-    showsPrec _ (PPDoc DocEmpty)                 =   id-    showsPrec _ (PPDoc (DocAppend l r))          =   shows (PPDoc l)  . shows (PPDoc r)-    showsPrec _ (PPDoc (DocString str))          =   showString str-    showsPrec _ (PPDoc (DocParagraph d))         =   shows (PPDoc d) . showChar '\n'-    showsPrec _ (PPDoc (DocIdentifier l))        =   foldr (\i _f -> showChar '\'' .-                                                     ((showString . showSDoc .  ppr) i) . showChar '\'') id l-    showsPrec _ (PPDoc (DocModule str))          =   showChar '"' . showString str . showChar '"'-    showsPrec _ (PPDoc (DocEmphasis doc))        =   showChar '/' . shows (PPDoc doc)  . showChar '/'-    showsPrec _ (PPDoc (DocMonospaced doc))      =   showChar '@' . shows (PPDoc doc) . showChar '@'-    showsPrec _ (PPDoc (DocUnorderedList l))     =-        foldr (\s r -> showString "* " . shows (PPDoc s) . showChar '\n' . r) id l-    showsPrec _ (PPDoc (DocOrderedList l))       =-        foldr (\(i,n) _f -> shows n . showSpace .  shows (PPDoc i)) id (zip l [1 .. length l])-    showsPrec _ (PPDoc (DocDefList li))          =-        foldr (\(l,r) f -> showString "[@" . shows (PPDoc l) . showString "[@ " . shows (PPDoc r) . f) id li-    showsPrec _ (PPDoc (DocCodeBlock doc))      =   showChar '@' . shows (PPDoc doc) . showChar '@'-    showsPrec _ (PPDoc (DocURL str))            =   showChar '<' . showString str . showChar '>'-    showsPrec _ (PPDoc (DocAName str))          =   showChar '#' . showString str . showChar '#'-    showsPrec _ (PPDoc _)                       =   id-#endif --------------------------------------------------------------------------------- -- Now the interface file stuff 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.StrippedPrefs@@ -31,6 +32,7 @@ import System.Directory (getHomeDirectory) import Control.Monad (liftM) import IDE.Core.CTypes (RetrieveStrategy(..))+import Data.Text (Text)  -- -- | Preferences is a data structure to hold configuration data@@ -38,7 +40,7 @@ data Prefs = Prefs {         sourceDirectories   ::   [FilePath]     ,   unpackDirectory     ::   Maybe FilePath-    ,   retrieveURL         ::   String+    ,   retrieveURL         ::   Text     ,   retrieveStrategy    ::   RetrieveStrategy     ,   serverPort          ::   Int     ,   endWithLastConn     ::   Bool

@@ -1,5 +1,6 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -XScopedTypeVariables -XBangPatterns #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Utils.FileUtils@@ -85,16 +86,17 @@ import Control.Exception as E (SomeException, catch) import System.IO.Strict (readFile) import qualified Data.Text as T-       (map, stripPrefix, isSuffixOf, take, length, unpack, init, last,-        words)+       (pack, map, stripPrefix, isSuffixOf, take, length, unpack, init,+        last, words) import Data.Monoid ((<>)) import Control.Applicative ((<$>))+import Data.Text (Text) -haskellSrcExts :: [String]+haskellSrcExts :: [FilePath] haskellSrcExts = ["hs","lhs","chs","hs.pp","lhs.pp","chs.pp","hsc"]  -- | canonicalizePath without crashing-myCanonicalizePath :: String -> IO String+myCanonicalizePath :: FilePath -> IO FilePath myCanonicalizePath fp = do     exists <- doesFileExist fp     if exists@@ -111,7 +113,7 @@     in res  findSourceFile :: [FilePath]-    -> [String]+    -> [FilePath]     -> ModuleName     -> IO (Maybe FilePath) findSourceFile directories exts modId  =@@ -122,7 +124,7 @@     in  find' allPossibles  findSourceFile' :: [FilePath]-    -> String+    -> FilePath     -> IO (Maybe FilePath) findSourceFile' directories modulePath  =     let allPathes       =   map (\ d -> d </> modulePath) directories@@ -160,13 +162,13 @@         then return (Just filePath)         else return Nothing -hasSavedConfigFile :: String -> IO Bool+hasSavedConfigFile :: FilePath -> IO Bool hasSavedConfigFile fn = do     savedConfigFile <- getConfigFilePathForSave fn     doesFileExist savedConfigFile  -getConfigFilePathForLoad :: String -> Maybe FilePath -> FilePath -> IO FilePath+getConfigFilePathForLoad :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath getConfigFilePathForLoad fn mbFilePath dataDir = do     mbCd <- case mbFilePath of                 Just p -> return (Just p)@@ -184,7 +186,7 @@                 then return (dataDir </> "data" </> fn)                 else error $"Config file not found: " ++ fn -getConfigFilePathForSave :: String -> IO FilePath+getConfigFilePathForSave :: FilePath -> IO FilePath getConfigFilePathForSave fn = do     cd <- getConfigDir     return (cd </> fn)@@ -206,7 +208,7 @@             let mbModuleNames = catMaybes $                                     map (\n -> case n of                                                     Nothing -> Nothing-                                                    Just s -> simpleParse s)+                                                    Just s -> simpleParse $ T.unpack s)                                         mbModuleStrs             otherModules <- mapM allModules dirs             return (mbModuleNames ++ concat otherModules)@@ -222,7 +224,7 @@ allHaskellSourceFiles :: FilePath -> IO [FilePath] allHaskellSourceFiles = allFilesWithExtensions [".hs",".lhs"] True [] -allFilesWithExtensions :: [String] -> Bool -> [FilePath] -> FilePath -> IO [FilePath]+allFilesWithExtensions :: [FilePath] -> Bool -> [FilePath] -> FilePath -> IO [FilePath] allFilesWithExtensions extensions recurseFurther collecting filePath = E.catch (do     exists <- doesDirectoryExist filePath     if exists@@ -243,7 +245,7 @@             $ \ (_ :: SomeException) -> return collecting  -moduleNameFromFilePath :: FilePath -> IO (Maybe String)+moduleNameFromFilePath :: FilePath -> IO (Maybe Text) moduleNameFromFilePath fp = E.catch (do     exists <- doesFileExist fp     if exists@@ -253,7 +255,7 @@         else return Nothing)             $ \ (_ :: SomeException) -> return Nothing -moduleNameFromFilePath' :: FilePath -> String -> IO (Maybe String)+moduleNameFromFilePath' :: FilePath -> FilePath -> IO (Maybe Text) moduleNameFromFilePath' fp str = do     let unlitRes = if takeExtension fp == ".lhs"                     then unlit fp str@@ -278,10 +280,10 @@ whiteSpace :: CharParser st () whiteSpace = P.whiteSpace lexer -symbol :: String -> CharParser st String-symbol = P.symbol lexer+symbol :: Text -> CharParser st Text+symbol = (T.pack <$>) . P.symbol lexer . T.unpack -moduleNameParser :: CharParser () String+moduleNameParser :: CharParser () Text moduleNameParser = do     whiteSpace     many skipPreproc@@ -300,18 +302,19 @@         return ())     <?> "preproc" -mident :: GenParser Char st String+mident :: GenParser Char st Text mident         = do{ c <- P.identStart haskellDef             ; cs <- many (alphaNum <|> oneOf "_'.")-            ; return (c:cs)+            ; return (T.pack (c:cs))             }         <?> "midentifier" -findKnownPackages :: FilePath -> IO (Set String)+findKnownPackages :: FilePath -> IO (Set Text) findKnownPackages filePath = E.catch (do     paths           <-  getDirectoryContents filePath-    let nameList    =   map dropExtension  $filter (\s -> leksahMetadataSystemFileExtension `isSuffixOf` s) paths+    let nameList    =   map (T.pack . dropExtension) $+            filter (\s -> leksahMetadataSystemFileExtension `isSuffixOf` s) paths     return (Set.fromList nameList))         $ \ (_ :: SomeException) -> return (Set.empty) @@ -427,20 +430,20 @@     replaceSpace ' ' = '-'     replaceSpace c = c -figureOutHaddockOpts :: IO [String]+figureOutHaddockOpts :: IO [Text] figureOutHaddockOpts = do     (!output,_) <- runTool' "cabal" (["haddock","--with-haddock=leksahecho","--executables"]) Nothing     let opts = concatMap (words . T.unpack . toolline) output     let res = filterOptGhc opts     debugM "leksah-server" ("figureOutHaddockOpts " ++ show res)-    return res+    return $ map T.pack res     where         filterOptGhc []    = []         filterOptGhc (s:r) = case stripPrefix "--optghc=" s of                                     Nothing -> filterOptGhc r                                     Just s'  -> s' : filterOptGhc r -figureOutGhcOpts :: IO [String]+figureOutGhcOpts :: IO [Text] figureOutGhcOpts = do     debugM "leksah-server" "figureOutGhcOpts"     (!output,_) <- runTool' "cabal" ["build","--with-ghc=leksahecho"] Nothing@@ -448,7 +451,7 @@                 options:_ -> words options                 _         -> []     debugM "leksah-server" $ ("figureOutGhcOpts " ++ show res)-    return res+    return $ map T.pack res     where         findMake [] = Nothing         findMake line@(_:xs) =

@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XCPP -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Utils.GHCUtils@@ -43,18 +45,24 @@ import qualified Parser as P (parseModule,parseHeader) import HscStats (ppSourceStats) #if MIN_VERSION_ghc(7,2,0)+#if !MIN_VERSION_ghc(7,7,0) import GhcMonad (Ghc(..))+#endif import SrcLoc (mkRealSrcLoc) #else import HscTypes (Ghc(..)) #endif import IDE.Utils.FileUtils (getSysLibDir) #if MIN_VERSION_ghc(7,7,0)-import DynFlags (dopt_set, DumpFlag(..), gopt_set,GeneralFlag(..))-#endif+import DynFlags (DumpFlag(..), gopt_set)+#else import DynFlags (dopt_set)+#endif import System.Log.Logger(debugM) import Control.Monad.IO.Class (MonadIO(..))+import Data.Text (Text)+import qualified Data.Text as T (pack, unpack)+import Data.Monoid ((<>))  #if !MIN_VERSION_ghc(7,7,0) -- this should not be repeated here, why is it necessary?@@ -63,9 +71,9 @@ #endif  #if MIN_VERSION_ghc(7,7,0)-inGhcIO :: [String] -> [GeneralFlag] -> (DynFlags -> Ghc a) -> IO a+inGhcIO :: [Text] -> [GeneralFlag] -> (DynFlags -> Ghc a) -> IO a #else-inGhcIO :: [String] -> [DynFlag] -> (DynFlags -> Ghc a) -> IO a+inGhcIO :: [Text] -> [DynFlag] -> (DynFlags -> Ghc a) -> IO a #endif inGhcIO flags' udynFlags ghcAct = do     debugM "leksah-server" $ "inGhcIO called with: " ++ show flags'@@ -83,7 +91,7 @@             ghcMode   = CompManager,             ghcLink   = NoLink             }-        dynflags''' <- parseGhcFlags dynflags'' (map noLoc flags') flags'+        dynflags''' <- parseGhcFlags dynflags'' (map (noLoc . T.unpack) flags') flags'         res <- defaultCleanupHandler dynflags''' $ do             setSessionDynFlags dynflags'''             ghcAct dynflags'''@@ -91,7 +99,7 @@         return res     where         parseGhcFlags :: DynFlags -> [Located String]-                  -> [String] -> Ghc DynFlags+                  -> [Text] -> Ghc DynFlags         parseGhcFlags dynflags flags_ _origFlags = do         (dynflags', rest, _) <- parseDynamicFlags dynflags flags_         if not (null rest)@@ -155,11 +163,7 @@       let loc  = mkSrcLoc (mkFastString src_filename) 1 0 #endif -#if MIN_VERSION_ghc(7,0,1)       case unP P.parseModule (mkPState dflags buf' loc) of {-#else-      case unP P.parseModule (mkPState buf' loc dflags) of {-#endif  #if MIN_VERSION_ghc(7,6,0)         PFailed span' err -> return (Left (mkPlainErrMsg dflags span' err));@@ -192,7 +196,7 @@ 	-- ToDo: free the string buffer later.       }} -myParseHeader :: FilePath -> String -> [String] -> IO (Either String (DynFlags, HsModule RdrName))+myParseHeader :: FilePath -> String -> [Text] -> IO (Either Text (DynFlags, HsModule RdrName)) myParseHeader fp _str opts = inGhcIO (opts++["-cpp"]) [] $ \ _dynFlags -> do     session   <- getSession #if MIN_VERSION_ghc(7,2,0)@@ -206,7 +210,7 @@         case parseResult of             Right (L _ mod') -> return (Right (dynFlags', mod'))             Left errMsg         -> do-                let str =  "Failed to parse " ++ show errMsg+                let str =  "Failed to parse " <> T.pack (show errMsg)                 return (Left str)   ---------------------------------------------------------------------

@@ -32,8 +32,9 @@  import Data.Word import System.Log.Logger (infoM)+import Data.Text (Text) -data UserAndGroup = UserAndGroup String String | UserWithDefaultGroup String+data UserAndGroup = UserAndGroup Text Text | UserWithDefaultGroup Text  -- | Set the user and group for the process. If the group is Nothing, then use the users default group. -- This is especially useful when you are root and want to become a user.

@@ -68,7 +68,8 @@        terminateProcess) import System.Process.Internals (StdStream(..)) #endif-import qualified Data.Text as T (null, lines, any, unpack, pack, filter)+import qualified Data.Text as T+       (unlines, unwords, null, lines, any, unpack, pack, filter) import Control.DeepSeq import System.Log.Logger (debugM) import System.Exit (ExitCode(..))@@ -79,6 +80,7 @@ import Data.Conduit as C        ((=$), ($$), ($=)) import qualified Data.Conduit as C+import Control.Monad.Trans.Resource (runResourceT) import qualified Data.Conduit.Text as CT (decode, utf8) import qualified Data.Conduit.List as CL        (consume, concatMap, concatMapAccumM, sequence, map)@@ -144,18 +146,18 @@ interruptProcessGroupOf = interruptProcessGroup #endif -runTool' :: FilePath -> [String] -> Maybe FilePath -> IO ([ToolOutput], ProcessHandle)+runTool' :: FilePath -> [Text] -> Maybe FilePath -> IO ([ToolOutput], ProcessHandle) runTool' fp args mbDir = do     debugM "leksah-server" $ "Start: " ++ show (fp, args)     (out,pid) <- runTool fp args mbDir-    output <- C.runResourceT $ out $$ CL.consume+    output <- runResourceT $ out $$ CL.consume     waitForProcess pid     debugM "leksah-server" $ "End: " ++ show (fp, args)     return (output,pid) -runTool :: MonadIO m => FilePath -> [String] -> Maybe FilePath -> IO (C.Source m ToolOutput, ProcessHandle)+runTool :: MonadIO m => FilePath -> [Text] -> Maybe FilePath -> IO (C.Source m ToolOutput, ProcessHandle) runTool executable arguments mbDir = do-    (Just inp,Just out,Just err,pid) <- createProcess (proc executable arguments)+    (Just inp,Just out,Just err,pid) <- createProcess (proc executable (map T.unpack arguments))         { std_in  = CreatePipe,           std_out = CreatePipe,           std_err = CreatePipe,@@ -186,11 +188,11 @@     ToolState ->     CommandLineReader ->     FilePath ->-    [String] ->+    [Text] ->     Maybe FilePath ->     IO () runInteractiveTool tool clr executable arguments mbDir = do-    (Just inp,Just out,Just err,pid) <- createProcess (proc executable arguments)+    (Just inp,Just out,Just err,pid) <- createProcess (proc executable (map T.unpack arguments))         { std_in  = CreatePipe,           std_out = CreatePipe,           std_err = CreatePipe,@@ -258,7 +260,7 @@             return (s, [])  {--newInteractiveTool :: (Handle -> Handle -> Handle -> ProcessHandle -> IO [RawToolOutput]) -> FilePath -> [String] -> IO ToolState+newInteractiveTool :: (Handle -> Handle -> Handle -> ProcessHandle -> IO [RawToolOutput]) -> FilePath -> [Text] -> IO ToolState newInteractiveTool getOutput' executable arguments = do     tool <- newToolState     runInteractiveTool tool getOutput' executable arguments@@ -484,7 +486,7 @@     output <- getOutput noInputCommandLineReader inp out err pid     return $ output $= CL.concatMap fromRawOutput -newGhci' :: [String] -> (C.Sink ToolOutput IO ()) -> IO ToolState+newGhci' :: [Text] -> (C.Sink ToolOutput IO ()) -> IO ToolState newGhci' flags startupOutputHandler = do     tool <- newToolState     writeChan (toolCommands tool) $@@ -492,27 +494,27 @@     runInteractiveTool tool ghciCommandLineReader "ghci" flags Nothing     return tool -newGhci :: FilePath -> Maybe String -> [String] -> (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) $-            ToolCommand (":set " <> T.pack (unwords interactiveFlags) <> "\n:set prompt " <> ghciPrompt) "" startupOutputHandler+            ToolCommand (":set " <> T.unwords interactiveFlags <> "\n:set prompt " <> ghciPrompt) "" startupOutputHandler         runInteractiveTool tool ghciCommandLineReader "cabal"             ("repl" : maybeToList mbExe) (Just dir)         return tool -executeCommand :: ToolState -> String -> String -> C.Sink ToolOutput IO () -> IO ()+executeCommand :: ToolState -> Text -> Text -> C.Sink ToolOutput IO () -> IO () executeCommand tool command rawCommand handler = do-    writeChan (toolCommands tool) $ ToolCommand (T.pack command) (T.pack rawCommand) handler+    writeChan (toolCommands tool) $ ToolCommand command rawCommand handler -executeGhciCommand :: ToolState -> String -> C.Sink ToolOutput IO () -> IO ()+executeGhciCommand :: ToolState -> Text -> C.Sink ToolOutput IO () -> IO () executeGhciCommand tool command handler = do-    if '\n' `elem` command+    if '\n' `elem` T.unpack command         then executeCommand tool safeCommand command handler         else executeCommand tool command command handler     where-        filteredLines = (filter safeLine (lines command))-        safeCommand = ":cmd (return " ++ show (":{\n" ++ unlines filteredLines ++ "\n:}") ++ ")"+        filteredLines = (filter safeLine (T.lines command))+        safeCommand = ":cmd (return " <> T.pack (show $ ":{\n" <> T.unlines filteredLines <> "\n:}") <> ")"         safeLine ":{" = False         safeLine ":}" = False         safeLine _ = True

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables, BangPatterns, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  IDE.Utils.VersionUtils@@ -24,6 +24,7 @@ import System.Log.Logger (debugM) import Control.Exception as E (SomeException, catch) import qualified Data.Text as T (unlines, unpack, init, last)+import Data.Text (Text)  getGhcVersion :: IO FilePath getGhcVersion = E.catch (do@@ -36,20 +37,20 @@     return $ T.unpack vers2     ) $ \ (_ :: SomeException) -> error ("FileUtils>>getGhcVersion failed") -getGhcInfo :: IO String+getGhcInfo :: IO Text getGhcInfo = E.catch (do     (!output,_) <- runTool' "ghc" ["--info"] Nothing-    return . T.unpack . T.unlines $ map toolline output+    return . T.unlines $ map toolline output     ) $ \ (_ :: SomeException) -> error ("FileUtils>>getGhcInfo failed") -getHaddockVersion :: IO String+getHaddockVersion :: IO Text getHaddockVersion = E.catch (do     (!output,_) <- runTool' "haddock" ["--version"] Nothing     let vers = toolline $ head output         vers2 = if ord (T.last vers) == 13                     then T.init vers                     else vers-    return $ T.unpack vers2+    return vers2     ) $ \ (_ :: SomeException) -> error ("FileUtils>>getHaddockVersion failed")  

@@ -18,17 +18,19 @@  import System.Environment (getArgs) import IDE.Utils.VersionUtils (getHaddockVersion, getGhcVersion, getGhcInfo)+import qualified Data.Text as T (unpack)+import Control.Applicative ((<$>))  main :: IO () main = do     args <- getArgs --    appendFile "/Users/hamish/lecho.log" $ show args ++ "/n"     if elem  "--version" args-        then putStrLn =<<  getHaddockVersion+        then putStrLn =<< T.unpack <$> getHaddockVersion         else if elem  "--ghc-version" args                 then putStrLn =<<  getGhcVersion                 else if elem  "--info" args-                        then putStrLn =<<  getGhcInfo+                        then putStrLn =<< T.unpack <$> getGhcInfo                         else if elem  "--numeric-version" args                                 then putStrLn =<<  getGhcVersion                                 else putStrLn $ unwords args