diff --git a/ihaskell.cabal b/ihaskell.cabal
index e486a7fc..838d73be 100644
--- a/ihaskell.cabal
+++ b/ihaskell.cabal
@@ -60,9 +60,6 @@ library
base64-bytestring >=1.0,
bytestring >=0.10,
cereal >=0.3,
- classy-prelude >=0.10.5 && <0.11,
- chunked-data ==0.1.*,
- mono-traversable >=0.6,
cmdargs >=0.10,
containers >=0.5,
directory -any,
@@ -74,10 +71,8 @@ library
here ==1.2.*,
hlint >=1.9 && <2.0,
haskell-src-exts ==1.16.*,
- hspec -any,
http-client == 0.4.*,
http-client-tls == 0.2.*,
- HUnit -any,
MissingH >=1.2,
mtl >=2.1,
parsec -any,
@@ -89,7 +84,6 @@ library
strict >=0.3,
system-argv0 -any,
system-filepath -any,
- tar -any,
text >=0.11,
transformers -any,
unix >= 2.6,
@@ -121,36 +115,72 @@ library
IHaskell.Types
IHaskell.BrokenPackages
Paths_ihaskell
--- other-modules:
--- Paths_ihaskell
+ other-modules:
+ IHaskellPrelude
+
+ default-extensions:
+ NoImplicitPrelude
+ DoAndIfThenElse
+ OverloadedStrings
+ ExtendedDefaultRules
executable ihaskell
-- .hs or .lhs file containing the Main module.
- main-is: src/Main.hs
+ main-is: Main.hs
+ hs-source-dirs: src
+ other-modules:
+ IHaskellPrelude
ghc-options: -threaded
-- Other library packages from which modules are imported.
default-language: Haskell2010
build-depends:
+ aeson >=0.7 && < 0.9,
base >=4.6 && < 4.9,
- aeson >=0.6 && < 0.9,
+ base64-bytestring >=1.0,
bytestring >=0.10,
cereal >=0.3,
- classy-prelude >=0.10.5 && <0.11,
- chunked-data ==0.1.*,
- mono-traversable >=0.6,
+ cmdargs >=0.10,
containers >=0.5,
directory -any,
- ghc >=7.6 && < 7.11,
- ihaskell -any,
- MissingH >=1.2,
+ filepath -any,
+ ghc >=7.6 || < 7.11,
+ ghc-parser >=0.1.7,
+ ghc-paths ==0.1.*,
+ haskeline -any,
here ==1.2.*,
- text -any,
- ipython-kernel >= 0.6.1,
- unix >= 2.6
+ hlint >=1.9 && <2.0,
+ haskell-src-exts ==1.16.*,
+ http-client == 0.4.*,
+ http-client-tls == 0.2.*,
+ MissingH >=1.2,
+ mtl >=2.1,
+ parsec -any,
+ process >=1.1,
+ random >=1.0,
+ shelly >=1.5,
+ split >= 0.2,
+ stm -any,
+ strict >=0.3,
+ system-argv0 -any,
+ system-filepath -any,
+ text >=0.11,
+ transformers -any,
+ unix >= 2.6,
+ unordered-containers -any,
+ utf8-string -any,
+ uuid >=1.3,
+ vector -any,
+ ipython-kernel >=0.6.1
if flag(binPkgDb)
build-depends: bin-package-db
+ default-extensions:
+ NoImplicitPrelude
+ DoAndIfThenElse
+ OverloadedStrings
+ ExtendedDefaultRules
+
Test-Suite hspec
Type: exitcode-stdio-1.0
Ghc-Options: -threaded
@@ -163,9 +193,6 @@ Test-Suite hspec
base64-bytestring >=1.0,
bytestring >=0.10,
cereal >=0.3,
- classy-prelude >=0.10.5 && <0.11,
- chunked-data ==0.1.*,
- mono-traversable >=0.6,
cmdargs >=0.10,
containers >=0.5,
directory -any,
@@ -190,7 +217,6 @@ Test-Suite hspec
strict >=0.3,
system-argv0 -any,
system-filepath -any,
- tar -any,
text >=0.11,
http-client == 0.4.*,
http-client-tls == 0.2.*,
diff --git a/src/IHaskell/BrokenPackages.hs b/src/IHaskell/BrokenPackages.hs
index 1eb6cb63..4a1a4664 100644
--- a/src/IHaskell/BrokenPackages.hs
+++ b/src/IHaskell/BrokenPackages.hs
@@ -1,8 +1,13 @@
-{-# LANGUAGE OverloadedStrings, NoImplicitPrelude, FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleContexts #-}
module IHaskell.BrokenPackages (getBrokenPackages) where
-import ClassyPrelude hiding ((<|>))
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
import Text.Parsec
import Text.Parsec.String
@@ -27,7 +32,7 @@ getBrokenPackages = shelly $ do
-- Get rid of extraneous things
let rightStart str = startswith "There are problems" str ||
startswith " dependency" str
- ghcPkgOutput = unlines . filter rightStart . lines $ unpack checkOut
+ ghcPkgOutput = unlines . filter rightStart . lines $ T.unpack checkOut
return $
case parse (many check) "ghc-pkg output" ghcPkgOutput of
diff --git a/src/IHaskell/Convert.hs b/src/IHaskell/Convert.hs
index ab74b1b5..75334697 100644
--- a/src/IHaskell/Convert.hs
+++ b/src/IHaskell/Convert.hs
@@ -1,6 +1,14 @@
+{-# LANGUAGE NoImplicitPrelude #-}
-- | Description : mostly reversible conversion between ipynb and lhs
module IHaskell.Convert (convert) where
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Control.Monad.Identity (Identity(Identity), unless, when)
import IHaskell.Convert.Args (ConvertSpec(..), fromJustConvertSpec, toConvertSpec)
import IHaskell.Convert.IpynbToLhs (ipynbToLhs)
diff --git a/src/IHaskell/Convert/Args.hs b/src/IHaskell/Convert/Args.hs
index eb58a7a5..0529ca4c 100644
--- a/src/IHaskell/Convert/Args.hs
+++ b/src/IHaskell/Convert/Args.hs
@@ -1,6 +1,14 @@
+{-# LANGUAGE NoImplicitPrelude #-}
-- | Description: interpret flags parsed by "IHaskell.Flags"
module IHaskell.Convert.Args (ConvertSpec(..), fromJustConvertSpec, toConvertSpec) where
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Control.Applicative ((<$>))
import Control.Monad.Identity (Identity(Identity))
import Data.Char (toLower)
@@ -17,7 +25,7 @@ data ConvertSpec f =
{ convertToIpynb :: f Bool
, convertInput :: f FilePath
, convertOutput :: f FilePath
- , convertLhsStyle :: f (LhsStyle T.Text)
+ , convertLhsStyle :: f (LhsStyle LT.Text)
, convertOverwriteFiles :: Bool
}
@@ -28,7 +36,7 @@ fromJustConvertSpec convertSpec = convertSpec
{ convertToIpynb = Identity toIpynb
, convertInput = Identity inputFile
, convertOutput = Identity outputFile
- , convertLhsStyle = Identity $ fromMaybe (T.pack <$> lhsStyleBird) (convertLhsStyle convertSpec)
+ , convertLhsStyle = Identity $ fromMaybe (LT.pack <$> lhsStyleBird) (convertLhsStyle convertSpec)
}
where
toIpynb = fromMaybe (error "Error: direction for conversion unknown")
@@ -63,10 +71,10 @@ mergeArg :: Argument -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArg OverwriteFiles convertSpec = convertSpec { convertOverwriteFiles = True }
mergeArg (ConvertLhsStyle lhsStyle) convertSpec
| Just previousLhsStyle <- convertLhsStyle convertSpec,
- previousLhsStyle /= fmap T.pack lhsStyle
+ previousLhsStyle /= fmap LT.pack lhsStyle
= error $ printf "Conflicting lhs styles requested: <%s> and <%s>" (show lhsStyle)
(show previousLhsStyle)
- | otherwise = convertSpec { convertLhsStyle = Just (T.pack <$> lhsStyle) }
+ | otherwise = convertSpec { convertLhsStyle = Just (LT.pack <$> lhsStyle) }
mergeArg (ConvertFrom inputFile) convertSpec
| Just previousInputFile <- convertInput convertSpec,
previousInputFile /= inputFile
diff --git a/src/IHaskell/Convert/IpynbToLhs.hs b/src/IHaskell/Convert/IpynbToLhs.hs
index e390d109..103456f0 100644
--- a/src/IHaskell/Convert/IpynbToLhs.hs
+++ b/src/IHaskell/Convert/IpynbToLhs.hs
@@ -1,66 +1,71 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module IHaskell.Convert.IpynbToLhs (ipynbToLhs) where
-import Control.Applicative ((<$>))
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Data.Aeson (decode, Object, Value(Array, Object, String))
-import qualified Data.ByteString.Lazy as L (readFile)
-import qualified Data.HashMap.Strict as M (lookup)
-import Data.Maybe (fromMaybe)
import Data.Monoid ((<>), Monoid(mempty))
-import qualified Data.Text.Lazy as T (concat, fromStrict, Text, unlines)
-import qualified Data.Text.Lazy.IO as T (writeFile)
import Data.Vector (Vector)
+import Data.HashMap.Strict (lookup)
+
+import qualified Data.Text.Lazy.IO as LTIO
import qualified Data.Vector as V (map, mapM, toList)
+
import IHaskell.Flags (LhsStyle(..))
-ipynbToLhs :: LhsStyle T.Text
+ipynbToLhs :: LhsStyle LText
-> FilePath -- ^ the filename of an ipython notebook
-> FilePath -- ^ the filename of the literate haskell to write
-> IO ()
ipynbToLhs sty from to = do
- Just (js :: Object) <- decode <$> L.readFile from
- case M.lookup "cells" js of
+ Just (js :: Object) <- decode <$> LBS.readFile from
+ case lookup "cells" js of
Just (Array cells) ->
- T.writeFile to $ T.unlines $ V.toList $ V.map (\(Object y) -> convCell sty y) cells
+ LTIO.writeFile to $ LT.unlines $ V.toList $ V.map (\(Object y) -> convCell sty y) cells
_ -> error "IHaskell.Convert.ipynbTolhs: json does not follow expected schema"
-concatWithPrefix :: T.Text -- ^ the prefix to add to every line
+concatWithPrefix :: LT.Text -- ^ the prefix to add to every line
-> Vector Value -- ^ a json array of text lines
- -> Maybe T.Text
-concatWithPrefix p arr = T.concat . map (p <>) . V.toList <$> V.mapM toStr arr
+ -> Maybe LT.Text
+concatWithPrefix p arr = LT.concat . map (p <>) . V.toList <$> V.mapM toStr arr
-toStr :: Value -> Maybe T.Text
-toStr (String x) = Just (T.fromStrict x)
+toStr :: Value -> Maybe LT.Text
+toStr (String x) = Just (LT.fromStrict x)
toStr _ = Nothing
-- | @convCell sty cell@ converts a single cell in JSON into text suitable for the type of lhs file
-- described by the @sty@
-convCell :: LhsStyle T.Text -> Object -> T.Text
+convCell :: LhsStyle LT.Text -> Object -> LT.Text
convCell _sty object
- | Just (String "markdown") <- M.lookup "cell_type" object,
- Just (Array xs) <- M.lookup "source" object,
+ | Just (String "markdown") <- lookup "cell_type" object,
+ Just (Array xs) <- lookup "source" object,
~(Just s) <- concatWithPrefix "" xs
= s
convCell sty object
- | Just (String "code") <- M.lookup "cell_type" object,
- Just (Array i) <- M.lookup "source" object,
- Just (Array o) <- M.lookup "outputs" object,
+ | Just (String "code") <- lookup "cell_type" object,
+ Just (Array i) <- lookup "source" object,
+ Just (Array o) <- lookup "outputs" object,
~(Just i) <- concatWithPrefix (lhsCodePrefix sty) i,
o <- fromMaybe mempty (convOutputs sty o)
= "\n" <>
lhsBeginCode sty <> i <> lhsEndCode sty <> "\n" <> o <> "\n"
convCell _ _ = "IHaskell.Convert.convCell: unknown cell"
-convOutputs :: LhsStyle T.Text
+convOutputs :: LhsStyle LT.Text
-> Vector Value -- ^ JSON array of output lines containing text or markup
- -> Maybe T.Text
+ -> Maybe LT.Text
convOutputs sty array = do
outputLines <- V.mapM (getTexts (lhsOutputPrefix sty)) array
- return $ lhsBeginOutput sty <> T.concat (V.toList outputLines) <> lhsEndOutput sty
+ return $ lhsBeginOutput sty <> LT.concat (V.toList outputLines) <> lhsEndOutput sty
-getTexts :: T.Text -> Value -> Maybe T.Text
+getTexts :: LT.Text -> Value -> Maybe LT.Text
getTexts p (Object object)
- | Just (Array text) <- M.lookup "text" object = concatWithPrefix p text
+ | Just (Array text) <- lookup "text" object = concatWithPrefix p text
getTexts _ _ = Nothing
diff --git a/src/IHaskell/Convert/LhsToIpynb.hs b/src/IHaskell/Convert/LhsToIpynb.hs
index dde1d66f..5ebca74c 100644
--- a/src/IHaskell/Convert/LhsToIpynb.hs
+++ b/src/IHaskell/Convert/LhsToIpynb.hs
@@ -1,24 +1,26 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module IHaskell.Convert.LhsToIpynb (lhsToIpynb) where
-import Control.Applicative ((<$>))
-import Control.Monad (mplus)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Data.Aeson ((.=), encode, object, Value(Array, Bool, Number, String, Null))
-import qualified Data.ByteString.Lazy as L (writeFile)
import Data.Char (isSpace)
-import Data.Monoid (Monoid(mempty))
-import qualified Data.Text as TS (Text)
-import qualified Data.Text.Lazy as T (dropWhile, lines, stripPrefix, Text, toStrict, snoc, strip)
-import qualified Data.Text.Lazy.IO as T (readFile)
import qualified Data.Vector as V (fromList, singleton)
+import qualified Data.List as List
+
import IHaskell.Flags (LhsStyle(LhsStyle))
-lhsToIpynb :: LhsStyle T.Text -> FilePath -> FilePath -> IO ()
+lhsToIpynb :: LhsStyle LText -> FilePath -> FilePath -> IO ()
lhsToIpynb sty from to = do
- classed <- classifyLines sty . T.lines <$> T.readFile from
- L.writeFile to . encode . encodeCells $ groupClassified classed
+ classed <- classifyLines sty . LT.lines . LT.pack <$> readFile from
+ LBS.writeFile to . encode . encodeCells $ groupClassified classed
data CellLine a = CodeLine a
| OutputLine a
@@ -50,40 +52,39 @@ data Cell a = Code a a
| Markdown a
deriving Show
-encodeCells :: [Cell [T.Text]] -> Value
+encodeCells :: [Cell [LText]] -> Value
encodeCells xs = object $
- ["cells" .= Array (V.fromList (map cellToVal xs))]
- ++ boilerplate
+ "cells" .= Array (V.fromList (map cellToVal xs)) : boilerplate
-cellToVal :: Cell [T.Text] -> Value
-cellToVal (Code i o) = object $
- [ "cell_type" .= String "code"
- , "execution_count" .= Null
- , "metadata" .= object ["collapsed" .= Bool False]
- , "source" .= arrayFromTxt i
- , "outputs" .= Array
- (V.fromList
- ([object
- [ "text" .= arrayFromTxt o
- , "metadata" .= object []
- , "output_type" .= String "display_data"
- ] | _ <- take 1 o]))
- ]
-cellToVal (Markdown txt) = object $
+cellToVal :: Cell [LText] -> Value
+cellToVal (Code i o) = object
+ [ "cell_type" .= String "code"
+ , "execution_count" .= Null
+ , "metadata" .= object ["collapsed" .= Bool False]
+ , "source" .= arrayFromTxt i
+ , "outputs" .= Array
+ (V.fromList
+ [object
+ [ "text" .= arrayFromTxt o
+ , "metadata" .= object []
+ , "output_type" .= String "display_data"
+ ] | _ <- take 1 o])
+ ]
+cellToVal (Markdown txt) = object
[ "cell_type" .= String "markdown"
, "metadata" .= object ["hidden" .= Bool False]
, "source" .= arrayFromTxt txt
]
-- | arrayFromTxt makes a JSON array of string s
-arrayFromTxt :: [T.Text] -> Value
+arrayFromTxt :: [LText] -> Value
arrayFromTxt i = Array (V.fromList $ map stringify i)
where
- stringify = String . T.toStrict . flip T.snoc '\n'
+ stringify = String . LT.toStrict . flip LT.snoc '\n'
-- | ihaskell needs this boilerplate at the upper level to interpret the json describing cells and
-- output correctly.
-boilerplate :: [(TS.Text, Value)]
+boilerplate :: [(T.Text, Value)]
boilerplate =
["metadata" .= object [kernelspec, lang], "nbformat" .= Number 4, "nbformat_minor" .= Number 0]
where
@@ -94,18 +95,18 @@ boilerplate =
]
lang = "language_info" .= object ["name" .= String "haskell", "version" .= String VERSION_ghc]
-groupClassified :: [CellLine T.Text] -> [Cell [T.Text]]
+groupClassified :: [CellLine LText] -> [Cell [LText]]
groupClassified (CodeLine a:x)
- | (c, x) <- span isCode x,
- (_, x) <- span isEmptyMD x,
- (o, x) <- span isOutput x
+ | (c, x) <- List.span isCode x,
+ (_, x) <- List.span isEmptyMD x,
+ (o, x) <- List.span isOutput x
= Code (a : map untag c) (map untag o) : groupClassified x
groupClassified (MarkdownLine a:x)
- | (m, x) <- span isMD x = Markdown (a : map untag m) : groupClassified x
+ | (m, x) <- List.span isMD x = Markdown (a : map untag m) : groupClassified x
groupClassified (OutputLine a:x) = Markdown [a] : groupClassified x
groupClassified [] = []
-classifyLines :: LhsStyle T.Text -> [T.Text] -> [CellLine T.Text]
+classifyLines :: LhsStyle LText -> [LText] -> [CellLine LText]
classifyLines sty@(LhsStyle c o _ _ _ _) (l:ls) =
case (sp c, sp o) of
(Just a, Nothing) -> CodeLine a : classifyLines sty ls
@@ -113,9 +114,9 @@ classifyLines sty@(LhsStyle c o _ _ _ _) (l:ls) =
(Nothing, Nothing) -> MarkdownLine l : classifyLines sty ls
_ -> error "IHaskell.Convert.classifyLines"
where
- sp x = T.stripPrefix (dropSpace x) (dropSpace l) `mplus` blankCodeLine x
- blankCodeLine x = if T.strip x == T.strip l
+ sp x = LT.stripPrefix (dropSpace x) (dropSpace l) `mplus` blankCodeLine x
+ blankCodeLine x = if LT.strip x == LT.strip l
then Just ""
else Nothing
- dropSpace = T.dropWhile isSpace
+ dropSpace = LT.dropWhile isSpace
classifyLines _ [] = []
diff --git a/src/IHaskell/Display.hs b/src/IHaskell/Display.hs
index 67d1bc53..2f5e7f70 100644
--- a/src/IHaskell/Display.hs
+++ b/src/IHaskell/Display.hs
@@ -48,18 +48,26 @@ module IHaskell.Display (
Widget(..),
) where
-import ClassyPrelude
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Data.Serialize as Serialize
-import Data.ByteString hiding (map, pack)
import Data.String.Utils (rstrip)
import qualified Data.ByteString.Base64 as Base64
-import qualified Data.ByteString.Char8 as Char
import Data.Aeson (Value)
import System.Directory (getTemporaryDirectory, setCurrentDirectory)
+import Control.Concurrent.STM (atomically)
+import Control.Exception (try)
import Control.Concurrent.STM.TChan
import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Text.Encoding as E
+
import IHaskell.Types
type Base64 = Text
@@ -92,23 +100,23 @@ many = ManyDisplay
-- | Generate a plain text display.
plain :: String -> DisplayData
-plain = DisplayData PlainText . pack . rstrip
+plain = DisplayData PlainText . T.pack . rstrip
-- | Generate an HTML display.
html :: String -> DisplayData
-html = DisplayData MimeHtml . pack
+html = DisplayData MimeHtml . T.pack
-- | Generate an SVG display.
svg :: String -> DisplayData
-svg = DisplayData MimeSvg . pack
+svg = DisplayData MimeSvg . T.pack
-- | Generate a LaTeX display.
latex :: String -> DisplayData
-latex = DisplayData MimeLatex . pack
+latex = DisplayData MimeLatex . T.pack
-- | Generate a Javascript display.
javascript :: String -> DisplayData
-javascript = DisplayData MimeJavascript . pack
+javascript = DisplayData MimeJavascript . T.pack
-- | Generate a PNG display of the given width and height. Data must be provided in a Base64 encoded
-- manner, suitable for embedding into HTML. The @base64@ function may be used to encode data into
@@ -124,11 +132,11 @@ jpg width height = DisplayData (MimeJpg width height)
-- | Convert from a string into base 64 encoded data.
encode64 :: String -> Base64
-encode64 str = base64 $ Char.pack str
+encode64 str = base64 $ CBS.pack str
-- | Convert from a ByteString into base 64 encoded data.
base64 :: ByteString -> Base64
-base64 = decodeUtf8 . Base64.encode
+base64 = E.decodeUtf8 . Base64.encode
-- | For internal use within IHaskell. Serialize displays to a ByteString.
serializeDisplay :: Display -> ByteString
diff --git a/src/IHaskell/Eval/Completion.hs b/src/IHaskell/Eval/Completion.hs
index 57b53cbd..19417c8b 100644
--- a/src/IHaskell/Eval/Completion.hs
+++ b/src/IHaskell/Eval/Completion.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse #-}
+{-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, DoAndIfThenElse #-}
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
{- |
@@ -13,7 +13,12 @@ This has a limited amount of context sensitivity. It distinguishes between four
-}
module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where
-import ClassyPrelude hiding (init, last, head, liftIO)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
import Control.Applicative ((<$>))
import Data.ByteString.UTF8 hiding (drop, take, lines, length)
@@ -34,11 +39,12 @@ import DynFlags
import GhcMonad
import PackageConfig
import Outputable (showPpr)
+import MonadUtils (MonadIO)
import System.Directory
import System.FilePath
-import MonadUtils (MonadIO)
+import Control.Exception (try)
import System.Console.Haskeline.Completion
@@ -155,7 +161,7 @@ getTrueModuleName name = do
onlyImportDecl _ = Nothing
-- Get all imports that we use.
- imports <- ClassyPrelude.catMaybes <$> map onlyImportDecl <$> getContext
+ imports <- catMaybes <$> map onlyImportDecl <$> getContext
-- Find the ones that have a qualified name attached. If this name isn't one of them, it already is
-- the true name.
diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs
index 895474a6..545f44db 100644
--- a/src/IHaskell/Eval/Evaluate.hs
+++ b/src/IHaskell/Eval/Evaluate.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
+{-# LANGUAGE NoImplicitPrelude, DoAndIfThenElse, NoOverloadedStrings, TypeSynonymInstances, GADTs, CPP #-}
{- | Description : Wrapper around GHC API, exposing a single `evaluate` interface that runs
a statement, declaration, import, or directive.
@@ -15,7 +15,13 @@ module IHaskell.Eval.Evaluate (
formatType,
) where
-import ClassyPrelude hiding (init, last, liftIO, head, hGetContents, tail, try)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Control.Concurrent (forkIO, threadDelay)
import Prelude (putChar, head, tail, last, init, (!!))
import Data.List.Utils
@@ -68,8 +74,6 @@ import FastString
import Bag
import ErrUtils (errMsgShortDoc, errMsgExtraInfo)
-import qualified System.IO.Strict as StrictIO
-
import IHaskell.Types
import IHaskell.IPython
import IHaskell.Eval.Parser
@@ -403,7 +407,7 @@ evalCommand _ (Module contents) state = wrapExecution state $ do
filename = last namePieces ++ ".hs"
liftIO $ do
createDirectoryIfMissing True directory
- writeFile (fpFromString $ directory ++ filename) contents
+ writeFile (directory ++ filename) contents
-- Clear old modules of this name
let modName = intercalate "." namePieces
@@ -565,7 +569,7 @@ evalCommand _ (Directive LoadFile names) state = wrapExecution state $ do
let filename = if endswith ".hs" name
then name
else name ++ ".hs"
- contents <- readFile $ fpFromString filename
+ contents <- liftIO $ readFile filename
modName <- intercalate "." <$> getModuleName contents
doLoadModule filename modName
return (ManyDisplay displays)
@@ -1016,7 +1020,7 @@ doLoadModule name modName = do
setSessionDynFlags
flags
{ hscTarget = objTarget flags
- , log_action = \dflags sev srcspan ppr msg -> modifyIORef errRef (showSDoc flags msg :)
+ , log_action = \dflags sev srcspan ppr msg -> modifyIORef' errRef (showSDoc flags msg :)
}
-- Load the new target.
diff --git a/src/IHaskell/Eval/Hoogle.hs b/src/IHaskell/Eval/Hoogle.hs
index 1ac55f3b..7308907e 100644
--- a/src/IHaskell/Eval/Hoogle.hs
+++ b/src/IHaskell/Eval/Hoogle.hs
@@ -8,16 +8,19 @@ module IHaskell.Eval.Hoogle (
HoogleResult,
) where
-import ClassyPrelude hiding (last, span, div)
-import Text.Printf
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Data.Aeson
import Data.String.Utils
-import Data.List (elemIndex, (!!), last)
+import qualified Data.List as List
import Data.Char (isAscii, isAlphaNum)
-import qualified Data.ByteString.Lazy.Char8 as Char
-import qualified Prelude as P
import IHaskell.IPython
@@ -52,11 +55,8 @@ instance FromJSON HoogleResponse where
query :: String -> IO (Either String String)
query str = do
request <- parseUrl $ queryUrl $ urlEncode str
- response <- try $ withManager tlsManagerSettings $ httpLbs request
- return $
- case response of
- Left err -> Left $ show (err :: SomeException)
- Right resp -> Right $ Char.unpack $ responseBody resp
+ catch (Right . CBS.unpack . LBS.toStrict . responseBody <$> withManager tlsManagerSettings (httpLbs request))
+ (\e -> return $ Left $ show (e :: SomeException))
where
queryUrl :: String -> String
@@ -66,25 +66,25 @@ query str = do
urlEncode :: String -> String
urlEncode [] = []
urlEncode (ch:t)
- | (isAscii ch && isAlphaNum ch) || ch `P.elem` ("-_.~" :: String) = ch : urlEncode t
- | not (isAscii ch) = P.foldr escape (urlEncode t) (eightBs [] (P.fromEnum ch))
- | otherwise = escape (P.fromEnum ch) (urlEncode t)
+ | (isAscii ch && isAlphaNum ch) || ch `elem` ("-_.~" :: String) = ch : urlEncode t
+ | not (isAscii ch) = foldr escape (urlEncode t) (eightBs [] (fromEnum ch))
+ | otherwise = escape (fromEnum ch) (urlEncode t)
where
escape :: Int -> String -> String
- escape b rs = '%' : showH (b `P.div` 16) (showH (b `mod` 16) rs)
+ escape b rs = '%' : showH (b `div` 16) (showH (b `mod` 16) rs)
showH :: Int -> String -> String
showH x xs
| x <= 9 = toEnum (o_0 + x) : xs
| otherwise = toEnum (o_A + (x - 10)) : xs
where
- o_0 = P.fromEnum '0'
- o_A = P.fromEnum 'A'
+ o_0 = fromEnum '0'
+ o_A = fromEnum 'A'
eightBs :: [Int] -> Int -> [Int]
eightBs acc x
| x <= 255 = x : acc
- | otherwise = eightBs ((x `mod` 256) : acc) (x `P.div` 256)
+ | otherwise = eightBs ((x `mod` 256) : acc) (x `div` 256)
-- | Search for a query on Hoogle. Return all search results.
search :: String -> IO [HoogleResult]
@@ -94,7 +94,7 @@ search string = do
case response of
Left err -> [NoResult err]
Right json ->
- case eitherDecode $ Char.pack json of
+ case eitherDecode $ LBS.fromStrict$ CBS.pack json of
Left err -> [NoResult err]
Right results ->
case map SearchResult results of
@@ -216,7 +216,7 @@ renderSelf string loc
renderDocs :: String -> String
renderDocs doc =
- let groups = groupBy bothAreCode $ lines doc
+ let groups = List.groupBy bothAreCode $ lines doc
nonull = filter (not . null . strip)
bothAreCode s1 s2 =
startswith ">" (strip s1) &&
@@ -224,28 +224,28 @@ renderDocs doc =
isCode (s:_) = startswith ">" $ strip s
makeBlock lines =
if isCode lines
- then div "hoogle-code" $ unlines $ nonull lines
- else div "hoogle-text" $ unlines $ nonull lines
- in div "hoogle-doc" $ unlines $ map makeBlock groups
+ then div' "hoogle-code" $ unlines $ nonull lines
+ else div' "hoogle-text" $ unlines $ nonull lines
+ in div' "hoogle-doc" $ unlines $ map makeBlock groups
extractPackageName :: String -> Maybe String
extractPackageName link = do
let pieces = split "/" link
- archiveLoc <- elemIndex "archive" pieces
- latestLoc <- elemIndex "latest" pieces
+ archiveLoc <- List.elemIndex "archive" pieces
+ latestLoc <- List.elemIndex "latest" pieces
guard $ latestLoc - archiveLoc == 2
- return $ pieces !! (latestLoc - 1)
+ return $ pieces List.!! (latestLoc - 1)
extractModuleName :: String -> Maybe String
extractModuleName link = do
let pieces = split "/" link
guard $ not $ null pieces
- let html = last pieces
+ let html = fromJust $ lastMay pieces
mod = replace "-" "." $ takeWhile (/= '.') html
return mod
-div :: String -> String -> String
-div = printf "
%s
"
+div' :: String -> String -> String
+div' = printf "%s
"
span :: String -> String -> String
span = printf "%s"
diff --git a/src/IHaskell/Eval/Info.hs b/src/IHaskell/Eval/Info.hs
index 499170a8..dcb87889 100644
--- a/src/IHaskell/Eval/Info.hs
+++ b/src/IHaskell/Eval/Info.hs
@@ -3,7 +3,12 @@
{- | Description : Inspect type and function information and documentation. -}
module IHaskell.Eval.Info (info) where
-import ClassyPrelude hiding (liftIO)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
import IHaskell.Eval.Evaluate (typeCleaner, Interpreter)
diff --git a/src/IHaskell/Eval/Inspect.hs b/src/IHaskell/Eval/Inspect.hs
index d21f2562..b0fd4962 100644
--- a/src/IHaskell/Eval/Inspect.hs
+++ b/src/IHaskell/Eval/Inspect.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-}
{- |
Description: Generates inspections when asked for by the frontend.
@@ -6,7 +6,13 @@ Description: Generates inspections when asked for by the frontend.
-}
module IHaskell.Eval.Inspect (inspect) where
-import ClassyPrelude
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import qualified Prelude as P
import Data.List.Split (splitOn)
diff --git a/src/IHaskell/Eval/Lint.hs b/src/IHaskell/Eval/Lint.hs
index 53700df9..599ec2de 100644
--- a/src/IHaskell/Eval/Lint.hs
+++ b/src/IHaskell/Eval/Lint.hs
@@ -1,10 +1,16 @@
-{-# LANGUAGE FlexibleContexts, NoImplicitPrelude, QuasiQuotes, ViewPatterns #-}
+{-# LANGUAGE NoImplicitPrelude, FlexibleContexts, QuasiQuotes, ViewPatterns #-}
module IHaskell.Eval.Lint (lint) where
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Data.String.Utils (replace, startswith, strip, split)
import Prelude (head, tail, last)
-import ClassyPrelude hiding (last)
import Control.Monad
import Data.List (findIndex)
import Text.Printf
diff --git a/src/IHaskell/Eval/ParseShell.hs b/src/IHaskell/Eval/ParseShell.hs
index c6efcabc..cf03bb49 100644
--- a/src/IHaskell/Eval/ParseShell.hs
+++ b/src/IHaskell/Eval/ParseShell.hs
@@ -1,10 +1,16 @@
+{-# LANGUAGE NoImplicitPrelude #-}
-- | This module splits a shell command line into a list of strings,
-- one for each command / filename
module IHaskell.Eval.ParseShell (parseShell) where
-import Prelude hiding (words)
-import Text.ParserCombinators.Parsec hiding (manyTill)
-import Control.Applicative hiding ((<|>), many, optional)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
+import Text.ParserCombinators.Parsec
eol :: Parser Char
eol = oneOf "\n\r" > "end of line"
@@ -12,18 +18,18 @@ eol = oneOf "\n\r" > "end of line"
quote :: Parser Char
quote = char '\"'
--- | @manyTill p end@ from hidden @manyTill@ in that it appends the result of @end@
-manyTill :: Parser a -> Parser [a] -> Parser [a]
-manyTill p end = scan
+-- | @manyTillEnd p end@ from normal @manyTill@ in that it appends the result of @end@
+manyTillEnd :: Parser a -> Parser [a] -> Parser [a]
+manyTillEnd p end = scan
where
scan = end <|> do
x <- p
xs <- scan
return $ x : xs
-manyTill1 p end = do
+manyTillEnd1 p end = do
x <- p
- xs <- manyTill p end
+ xs <- manyTillEnd p end
return $ x : xs
unescapedChar :: Parser Char -> Parser String
@@ -34,9 +40,9 @@ unescapedChar p = try $ do
quotedString = do
quote > "expected starting quote"
- (manyTill anyChar (unescapedChar quote) <* quote) > "unexpected in quoted String "
+ (manyTillEnd anyChar (unescapedChar quote) <* quote) > "unexpected in quoted String "
-unquotedString = manyTill1 anyChar end
+unquotedString = manyTillEnd1 anyChar end
where
end = unescapedChar space
<|> (lookAhead eol >> return [])
@@ -47,14 +53,14 @@ separator :: Parser String
separator = many1 space > "separator"
-- | Input must terminate in a space character (like a \n)
-words :: Parser [String]
-words = try (eof *> return []) <|> do
+shellWords :: Parser [String]
+shellWords = try (eof *> return []) <|> do
x <- word
rest1 <- lookAhead (many anyToken)
ss <- separator
rest2 <- lookAhead (many anyToken)
- xs <- words
+ xs <- shellWords
return $ x : xs
parseShell :: String -> Either ParseError [String]
-parseShell string = parse words "shell" (string ++ "\n")
+parseShell string = parse shellWords "shell" (string ++ "\n")
diff --git a/src/IHaskell/Eval/Parser.hs b/src/IHaskell/Eval/Parser.hs
index c408ff8b..23c21f78 100644
--- a/src/IHaskell/Eval/Parser.hs
+++ b/src/IHaskell/Eval/Parser.hs
@@ -15,7 +15,12 @@ module IHaskell.Eval.Parser (
PragmaType(..),
) where
-import ClassyPrelude hiding (head, liftIO, maximumBy)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
import Data.List (maximumBy, inits)
import Data.String.Utils (startswith, strip, split)
diff --git a/src/IHaskell/Eval/Util.hs b/src/IHaskell/Eval/Util.hs
index 54baebf0..13976fb4 100644
--- a/src/IHaskell/Eval/Util.hs
+++ b/src/IHaskell/Eval/Util.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, CPP #-}
module IHaskell.Eval.Util (
-- * Initialization
@@ -23,7 +23,12 @@ module IHaskell.Eval.Util (
pprLanguages,
) where
-import ClassyPrelude hiding ((<>))
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
-- GHC imports.
import DynFlags
@@ -34,7 +39,6 @@ import HsImpExp
import HscTypes
import InteractiveEval
import Module
-import Outputable
import Packages
import RdrName
import NameSet
@@ -44,6 +48,7 @@ import InstEnv (ClsInst(..))
import Unify (tcMatchTys)
import VarSet (mkVarSet)
import qualified Pretty
+import qualified Outputable as O
import Control.Monad (void)
import Data.Function (on)
@@ -80,15 +85,15 @@ flagSpecFlag (_, flag, _) = flag
-- | Pretty-print dynamic flags (taken from 'InteractiveUI' module of `ghc-bin`)
pprDynFlags :: Bool -- ^ Whether to include flags which are on by default
-> DynFlags
- -> SDoc
+ -> O.SDoc
pprDynFlags show_all dflags =
- vcat
- [ text "GHCi-specific dynamic flag settings:" $$
- nest 2 (vcat (map (setting opt) ghciFlags))
- , text "other dynamic, non-language, flag settings:" $$
- nest 2 (vcat (map (setting opt) others))
- , text "warning settings:" $$
- nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))
+ O.vcat
+ [ O.text "GHCi-specific dynamic flag settings:" O.$$
+ O.nest 2 (O.vcat (map (setting opt) ghciFlags))
+ , O.text "other dynamic, non-language, flag settings:" O.$$
+ O.nest 2 (O.vcat (map (setting opt) others))
+ , O.text "warning settings:" O.$$
+ O.nest 2 (O.vcat (map (setting wopt) DynFlags.fWarningFlags))
]
where
@@ -98,9 +103,9 @@ pprDynFlags show_all dflags =
opt = dopt
#endif
setting test flag
- | quiet = empty
- | is_on = fstr name
- | otherwise = fnostr name
+ | quiet = O.empty :: O.SDoc
+ | is_on = fstr name :: O.SDoc
+ | otherwise = fnostr name :: O.SDoc
where
name = flagSpecName flag
f = flagSpecFlag flag
@@ -109,9 +114,9 @@ pprDynFlags show_all dflags =
default_dflags = defaultDynFlags (settings dflags)
- fstr str = text "-f" <> text str
-
- fnostr str = text "-fno-" <> text str
+ fstr, fnostr :: String -> O.SDoc
+ fstr str = O.text "-f" O.<> O.text str
+ fnostr str = O.text "-fno-" O.<> O.text str
(ghciFlags, others) = partition (\f -> flagSpecFlag f `elem` flgs) DynFlags.fFlags
@@ -129,22 +134,22 @@ flgs3 = [Opt_PrintBindResult, Opt_BreakOnException, Opt_BreakOnError, Opt_PrintE
-- `ghc-bin`)
pprLanguages :: Bool -- ^ Whether to include flags which are on by default
-> DynFlags
- -> SDoc
+ -> O.SDoc
pprLanguages show_all dflags =
- vcat
- [text "base language is: " <>
+ O.vcat
+ [O.text "base language is: " O.<>
case language dflags of
- Nothing -> text "Haskell2010"
- Just Haskell98 -> text "Haskell98"
- Just Haskell2010 -> text "Haskell2010", (if show_all
- then text "all active language options:"
- else text "with the following modifiers:") $$
- nest 2 (vcat (map (setting xopt) DynFlags.xFlags))]
+ Nothing -> O.text "Haskell2010"
+ Just Haskell98 -> O.text "Haskell98"
+ Just Haskell2010 -> O.text "Haskell2010", (if show_all
+ then O.text "all active language options:"
+ else O.text "with the following modifiers:") O.$$
+ O.nest 2 (O.vcat (map (setting xopt) DynFlags.xFlags))]
where
setting test flag
- | quiet = empty
- | is_on = text "-X" <> text name
- | otherwise = text "-XNo" <> text name
+ | quiet = O.empty
+ | is_on = O.text "-X" O.<> O.text name
+ | otherwise = O.text "-XNo" O.<> O.text name
where
name = flagSpecName flag
f = flagSpecFlag flag
@@ -196,13 +201,13 @@ setFlags ext = do
-- does not impose an arbitrary width limit on the output (in terms of number of columns). Instead,
-- it respsects the 'pprCols' field in the structure returned by 'getSessionDynFlags', and thus
-- gives a configurable width of output.
-doc :: GhcMonad m => SDoc -> m String
+doc :: GhcMonad m => O.SDoc -> m String
doc sdoc = do
flags <- getSessionDynFlags
unqual <- getPrintUnqual
- let style = mkUserStyle unqual AllTheWay
+ let style = O.mkUserStyle unqual O.AllTheWay
let cols = pprCols flags
- d = runSDoc sdoc (initSDocContext flags style)
+ d = O.runSDoc sdoc (O.initSDocContext flags style)
return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d
where
@@ -298,7 +303,7 @@ evalDeclarations decl = do
names <- runDecls decl
cleanUpDuplicateInstances
flags <- getSessionDynFlags
- return $ map (replace ":Interactive." "" . showPpr flags) names
+ return $ map (replace ":Interactive." "" . O.showPpr flags) names
cleanUpDuplicateInstances :: GhcMonad m => m ()
cleanUpDuplicateInstances = modifySession $ \hscEnv ->
@@ -326,7 +331,7 @@ getType :: GhcMonad m => String -> m String
getType expr = do
result <- exprType expr
flags <- getSessionDynFlags
- let typeStr = showSDocUnqual flags $ ppr result
+ let typeStr = O.showSDocUnqual flags $ O.ppr result
return typeStr
-- | A wrapper around @getInfo@. Return info about each name in the string.
@@ -363,16 +368,16 @@ getDescription str = do
#if MIN_VERSION_ghc(7,8,0)
printInfo (thing, fixity, classInstances, famInstances) =
- pprTyThingInContextLoc thing $$
- showFixity thing fixity $$
- vcat (map GHC.pprInstance classInstances) $$
- vcat (map GHC.pprFamInst famInstances)
+ pprTyThingInContextLoc thing O.$$
+ showFixity thing fixity O.$$
+ O.vcat (map GHC.pprInstance classInstances) O.$$
+ O.vcat (map GHC.pprFamInst famInstances)
#else
printInfo (thing, fixity, classInstances) =
- pprTyThingInContextLoc False thing $$ showFixity thing fixity $$
- vcat (map GHC.pprInstance classInstances)
+ pprTyThingInContextLoc False thing O.$$ showFixity thing fixity O.$$
+ O.vcat (map GHC.pprInstance classInstances)
#endif
showFixity thing fixity =
if fixity == GHC.defaultFixity
- then empty
- else ppr fixity <+> pprInfixName (getName thing)
+ then O.empty
+ else O.ppr fixity O.<+> pprInfixName (getName thing)
diff --git a/src/IHaskell/Flags.hs b/src/IHaskell/Flags.hs
index 68cb5208..96b52c51 100644
--- a/src/IHaskell/Flags.hs
+++ b/src/IHaskell/Flags.hs
@@ -11,7 +11,13 @@ module IHaskell.Flags (
help,
) where
-import ClassyPrelude
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import Data.List (findIndex)
@@ -63,7 +69,7 @@ parseFlags flags =
Nothing ->
-- Treat no mode as 'console'.
if "--help" `elem` flags
- then Left $ pack (showText (Wrap 100) $ helpText [] HelpFormatAll ihaskellArgs)
+ then Left $ showText (Wrap 100) $ helpText [] HelpFormatAll ihaskellArgs
else process ihaskellArgs flags
Just 0 -> process ihaskellArgs flags
@@ -139,13 +145,13 @@ convert = mode "convert" (Args ConvertLhs []) description unnamedArg convertFlag
consStyle style (Args mode prev) = Args mode (ConvertLhsStyle style : prev)
storeFormat constructor str (Args mode prev) =
- case toLower str of
+ case T.toLower (T.pack str) of
"lhs" -> Right $ Args mode $ constructor LhsMarkdown : prev
"ipynb" -> Right $ Args mode $ constructor IpynbFile : prev
_ -> Left $ "Unknown format requested: " ++ str
storeLhs str previousArgs =
- case toLower str of
+ case T.toLower (T.pack str) of
"bird" -> success lhsStyleBird
"tex" -> success lhsStyleTex
_ -> Left $ "Unknown lhs style: " ++ str
diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs
index dbb17276..134409fd 100644
--- a/src/IHaskell/IPython.hs
+++ b/src/IHaskell/IPython.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
-- | Description : Shell scripting wrapper using @Shelly@ for the @notebook@, and
@@ -15,18 +14,21 @@ module IHaskell.IPython (
defaultKernelSpecOptions,
) where
-import ClassyPrelude
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Control.Concurrent (threadDelay)
-import Prelude (read, reads, init)
-import Shelly hiding (find, trace, path, (>))
import System.Argv0
import System.Directory
+import qualified Shelly as SH
import qualified Filesystem.Path.CurrentOS as FS
+import qualified System.IO as IO
import Data.List.Utils (split)
import Data.String.Utils (rstrip, endswith, strip, replace)
-import Text.Printf
-import qualified Data.Text as T
-import Data.Maybe (fromJust)
import System.Exit (exitFailure)
import Data.Aeson (toJSON)
import Data.Aeson.Encode (encodeToTextBuilder)
@@ -34,7 +36,6 @@ import Data.Text.Lazy.Builder (toLazyText)
import qualified System.IO.Strict as StrictIO
import qualified Paths_ihaskell as Paths
-import qualified Codec.Archive.Tar as Tar
import qualified GHC.Paths
import IHaskell.Types
@@ -64,72 +65,75 @@ kernelArgs = ["--kernel", kernelName]
-- | Run the IPython command with any arguments. The kernel is set to IHaskell.
ipython :: Bool -- ^ Whether to suppress output.
-> [Text] -- ^ IPython command line arguments.
- -> Sh String -- ^ IPython output.
+ -> SH.Sh String -- ^ IPython output.
ipython suppress args = do
liftIO $ installHandler keyboardSignal (CatchOnce $ return ()) Nothing
-- We have this because using `run` does not let us use stdin.
- runHandles "ipython" args handles doNothing
+ SH.runHandles "ipython" args handles doNothing
where
- handles = [InHandle Inherit, outHandle suppress, errorHandle suppress]
- outHandle True = OutHandle CreatePipe
- outHandle False = OutHandle Inherit
- errorHandle True = ErrorHandle CreatePipe
- errorHandle False = ErrorHandle Inherit
+ handles = [SH.InHandle SH.Inherit, outHandle suppress, errorHandle suppress]
+ outHandle True = SH.OutHandle SH.CreatePipe
+ outHandle False = SH.OutHandle SH.Inherit
+ errorHandle True = SH.ErrorHandle SH.CreatePipe
+ errorHandle False = SH.ErrorHandle SH.Inherit
doNothing _ stdout _ = if suppress
then liftIO $ StrictIO.hGetContents stdout
else return ""
-- | Run while suppressing all output.
-quietRun path args = runHandles path args handles nothing
+quietRun path args = SH.runHandles path args handles nothing
where
- handles = [InHandle Inherit, OutHandle CreatePipe, ErrorHandle CreatePipe]
+ handles = [SH.InHandle SH.Inherit, SH.OutHandle SH.CreatePipe, SH.ErrorHandle SH.CreatePipe]
nothing _ _ _ = return ()
+fp :: FS.FilePath -> FilePath
+fp = T.unpack . SH.toTextIgnore
+
-- | Create the directory and return it.
-ensure :: Sh FilePath -> Sh FilePath
+ensure :: SH.Sh FS.FilePath -> SH.Sh FS.FilePath
ensure getDir = do
dir <- getDir
- mkdir_p dir
+ SH.mkdir_p dir
return dir
-- | Return the data directory for IHaskell.
-ihaskellDir :: Sh FilePath
+ihaskellDir :: SH.Sh FilePath
ihaskellDir = do
- home <- maybe (error "$HOME not defined.") fromText <$> get_env "HOME"
- ensure $ return (home > ".ihaskell")
+ home <- maybe (error "$HOME not defined.") FS.fromText <$> SH.get_env "HOME"
+ fp <$> ensure (return (home SH.> ".ihaskell"))
-ipythonDir :: Sh FilePath
-ipythonDir = ensure $ (> "ipython") <$> ihaskellDir
+ipythonDir :: SH.Sh FS.FilePath
+ipythonDir = ensure $ (SH.> "ipython") <$> ihaskellDir
-notebookDir :: Sh FilePath
-notebookDir = ensure $ (> "notebooks") <$> ihaskellDir
+notebookDir :: SH.Sh FS.FilePath
+notebookDir = ensure $ (SH.> "notebooks") <$> ihaskellDir
getIHaskellDir :: IO String
-getIHaskellDir = shelly $ fpToString <$> ihaskellDir
+getIHaskellDir = SH.shelly ihaskellDir
defaultConfFile :: IO (Maybe String)
-defaultConfFile = shelly $ do
- filename <- (> "rc.hs") <$> ihaskellDir
- exists <- test_f filename
+defaultConfFile = fmap (fmap fp) . SH.shelly $ do
+ filename <- (SH.> "rc.hs") <$> ihaskellDir
+ exists <- SH.test_f filename
return $ if exists
- then Just $ fpToString filename
+ then Just filename
else Nothing
replaceIPythonKernelspec :: KernelSpecOptions -> IO ()
-replaceIPythonKernelspec kernelSpecOpts = shelly $ do
+replaceIPythonKernelspec kernelSpecOpts = SH.shelly $ do
verifyIPythonVersion
installKernelspec True kernelSpecOpts
-- | Verify that a proper version of IPython is installed and accessible.
-verifyIPythonVersion :: Sh ()
+verifyIPythonVersion :: SH.Sh ()
verifyIPythonVersion = do
- pathMay <- which "ipython"
+ pathMay <- SH.which "ipython"
case pathMay of
Nothing -> badIPython "No IPython detected -- install IPython 3.0+ before using IHaskell."
Just path -> do
- output <- unpack <$> silently (run path ["--version"])
+ output <- T.unpack <$> SH.silently (SH.run path ["--version"])
case parseVersion output of
Just (3:_) -> return ()
Just (2:_) -> oldIPython
@@ -138,15 +142,15 @@ verifyIPythonVersion = do
_ -> badIPython "Detected IPython, but could not parse version number."
where
- badIPython :: Text -> Sh ()
+ badIPython :: Text -> SH.Sh ()
badIPython message = liftIO $ do
- hPutStrLn stderr message
+ IO.hPutStrLn IO.stderr (T.unpack message)
exitFailure
oldIPython = badIPython "Detected old version of IPython. IHaskell requires 3.0.0 or up."
-- | Install an IHaskell kernelspec into the right location. The right location is determined by
-- using `ipython kernelspec install --user`.
-installKernelspec :: Bool -> KernelSpecOptions -> Sh ()
+installKernelspec :: Bool -> KernelSpecOptions -> SH.Sh ()
installKernelspec replace opts = void $ do
ihaskellPath <- getIHaskellPath
confFile <- liftIO $ kernelSpecConfFile opts
@@ -167,63 +171,57 @@ installKernelspec replace opts = void $ do
-- Create a temporary directory. Use this temporary directory to make a kernelspec directory; then,
-- shell out to IPython to install this kernelspec directory.
- withTmpDir $ \tmp -> do
- let kernelDir = tmp > kernelName
- let filename = kernelDir > "kernel.json"
+ SH.withTmpDir $ \tmp -> do
+ let kernelDir = tmp SH.> kernelName
+ let filename = kernelDir SH.> "kernel.json"
- mkdir_p kernelDir
- writefile filename $ toStrict $ toLazyText $ encodeToTextBuilder $ toJSON kernelSpec
+ SH.mkdir_p kernelDir
+ SH.writefile filename $ LT.toStrict $ toLazyText $ encodeToTextBuilder $ toJSON kernelSpec
let files = ["kernel.js", "logo-64x64.png"]
forM_ files $ \file -> do
src <- liftIO $ Paths.getDataFileName $ "html/" ++ file
- cp (fpFromString src) (tmp > kernelName > fpFromString file)
+ SH.cp (FS.fromText $ T.pack src) (tmp SH.> kernelName SH.> file)
- Just ipython <- which "ipython"
+ Just ipython <- SH.which "ipython"
let replaceFlag = ["--replace" | replace]
- cmd = ["kernelspec", "install", "--user", fpToText kernelDir] ++ replaceFlag
- silently $ run ipython cmd
+ cmd = ["kernelspec", "install", "--user", kernelDir] ++ replaceFlag
+ SH.silently $ SH.run ipython (map SH.toTextIgnore cmd)
-kernelSpecCreated :: Sh Bool
+kernelSpecCreated :: SH.Sh Bool
kernelSpecCreated = do
- Just ipython <- which "ipython"
- out <- silently $ run ipython ["kernelspec", "list"]
- let kernelspecs = map T.strip $ lines out
+ Just ipython <- SH.which "ipython"
+ out <- SH.silently $ SH.run ipython ["kernelspec", "list"]
+ let kernelspecs = map T.strip $ T.lines out
return $ kernelName `elem` kernelspecs
-- | Replace "~" with $HOME if $HOME is defined. Otherwise, do nothing.
subHome :: String -> IO String
-subHome path = shelly $ do
- home <- unpack <$> fromMaybe "~" <$> get_env "HOME"
+subHome path = SH.shelly $ do
+ home <- T.unpack <$> fromMaybe "~" <$> SH.get_env "HOME"
return $ replace "~" home path
-- | Get the path to an executable. If it doensn't exist, fail with an error message complaining
-- about it.
-path :: Text -> Sh FilePath
+path :: Text -> SH.Sh FS.FilePath
path exe = do
- path <- which $ fromText exe
+ path <- SH.which $ FS.fromText exe
case path of
Nothing -> do
- putStrLn $ "Could not find `" ++ exe ++ "` executable."
- fail $ "`" ++ unpack exe ++ "` not on $PATH."
+ liftIO $ putStrLn $ "Could not find `" ++ T.unpack exe ++ "` executable."
+ fail $ "`" ++ T.unpack exe ++ "` not on $PATH."
Just exePath -> return exePath
-- | Parse an IPython version string into a list of integers.
parseVersion :: String -> Maybe [Int]
parseVersion versionStr =
- let versions = map read' $ split "." versionStr
+ let versions = map readMay $ split "." versionStr
parsed = all isJust versions
in if parsed
then Just $ map fromJust versions
else Nothing
- where
- read' :: String -> Maybe Int
- read' x =
- case reads x of
- [(n, _)] -> Just n
- _ -> Nothing
-- | Get the absolute path to this IHaskell executable.
-getIHaskellPath :: Sh String
+getIHaskellPath :: SH.Sh String
getIHaskellPath = do
-- Get the absolute filepath to the argument.
f <- liftIO getArgv0
@@ -236,17 +234,17 @@ getIHaskellPath = do
-- the shell. If it's just 'IHaskell', use the $PATH variable to find where IHaskell lives.
if FS.filename f == f
then do
- ihaskellPath <- which "ihaskell"
+ ihaskellPath <- SH.which "ihaskell"
case ihaskellPath of
Nothing -> error "ihaskell not on $PATH and not referenced relative to directory."
Just path -> return $ FS.encodeString path
else do
-- If it's actually a relative path, make it absolute.
cd <- liftIO getCurrentDirectory
- return $ FS.encodeString $ FS.decodeString cd FS.> f
+ return $ FS.encodeString $ FS.decodeString cd SH.> f
getSandboxPackageConf :: IO (Maybe String)
-getSandboxPackageConf = shelly $ do
+getSandboxPackageConf = SH.shelly $ do
myPath <- getIHaskellPath
let sandboxName = ".cabal-sandbox"
if not $ sandboxName `isInfixOf` myPath
@@ -254,8 +252,8 @@ getSandboxPackageConf = shelly $ do
else do
let pieces = split "/" myPath
sandboxDir = intercalate "/" $ takeWhile (/= sandboxName) pieces ++ [sandboxName]
- subdirs <- ls $ fpFromString sandboxDir
- let confdirs = filter (endswith "packages.conf.d") $ map fpToString subdirs
+ subdirs <- map fp <$> SH.ls (FS.fromText $ T.pack sandboxDir)
+ let confdirs = filter (endswith ("packages.conf.d" :: String)) subdirs
case confdirs of
[] -> return Nothing
dir:_ ->
diff --git a/src/IHaskell/IPython/Stdin.hs b/src/IHaskell/IPython/Stdin.hs
index ac9137ca..da4757a3 100644
--- a/src/IHaskell/IPython/Stdin.hs
+++ b/src/IHaskell/IPython/Stdin.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse #-}
-- | This module provides a way in which the Haskell standard input may be forwarded to the IPython
-- frontend and thus allows the notebook to use the standard input.
@@ -12,6 +12,7 @@
-- communication. For this, use @recordKernelProfile@ once the profile is known. Both this and
-- @recordParentHeader@ take a directory name where they can store this data.
--
+--
-- Finally, the module must know what @execute_request@ message is currently being replied to (which
-- will request the input). Thus, every time the language kernel receives an @execute_request@
-- message, it should inform this module via @recordParentHeader@, so that the module may generate
@@ -24,13 +25,19 @@
-- the host code.
module IHaskell.IPython.Stdin (fixStdin, recordParentHeader, recordKernelProfile) where
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import Control.Concurrent
import Control.Applicative ((<$>))
import Control.Concurrent.Chan
import Control.Monad
import GHC.IO.Handle
import GHC.IO.Handle.Types
-import System.IO
import System.Posix.IO
import System.IO.Unsafe
import qualified Data.Map as Map
@@ -48,7 +55,7 @@ stdinInterface = unsafePerformIO newEmptyMVar
fixStdin :: String -> IO ()
fixStdin dir = do
-- Initialize the stdin interface.
- profile <- read <$> readFile (dir ++ "/.kernel-profile")
+ profile <- fromJust . readMay <$> readFile (dir ++ "/.kernel-profile")
interface <- serveStdin profile
putMVar stdinInterface interface
void $ forkIO $ stdinOnce dir
@@ -87,7 +94,7 @@ getInputLine dir = do
-- Send a request for input.
uuid <- UUID.random
- parentHeader <- read <$> readFile (dir ++ "/.last-req-header")
+ parentHeader <- fromJust . readMay <$> readFile (dir ++ "/.last-req-header")
let header = MessageHeader
{ username = username parentHeader
, identifiers = identifiers parentHeader
diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs
index ce8340bc..63a1e208 100644
--- a/src/IHaskell/Types.hs
+++ b/src/IHaskell/Types.hs
@@ -30,11 +30,16 @@ module IHaskell.Types (
KernelSpec(..),
) where
-import ClassyPrelude
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
+
import qualified Data.ByteString.Char8 as Char
import Data.Serialize
import GHC.Generics
-import Data.Map (Map, empty)
import Data.Aeson (Value)
import IHaskell.IPython.Kernel
@@ -103,9 +108,6 @@ instance Monoid Display where
a `mappend` ManyDisplay b = ManyDisplay (a : b)
a `mappend` b = ManyDisplay [a, b]
-instance Semigroup Display where
- a <> b = a `mappend` b
-
-- | All state stored in the kernel between executions.
data KernelState =
KernelState
@@ -128,7 +130,7 @@ defaultKernelState = KernelState
, useShowErrors = False
, useShowTypes = False
, usePager = True
- , openComms = empty
+ , openComms = mempty
, kernelDebug = False
}
@@ -177,4 +179,4 @@ data EvaluationResult =
-- pager.
, startComms :: [CommInfo] -- ^ Comms to start.
}
- deriving Show
\ No newline at end of file
+ deriving Show
diff --git a/src/IHaskellPrelude.hs b/src/IHaskellPrelude.hs
new file mode 100644
index 00000000..79e1fffd
--- /dev/null
+++ b/src/IHaskellPrelude.hs
@@ -0,0 +1,138 @@
+module IHaskellPrelude (
+ module IHaskellPrelude,
+ module X,
+
+ -- Select reexports
+ Data.Typeable.Proxy,
+ Data.Typeable.Typeable,
+ Data.Typeable.cast,
+
+ GHC.Exts.IsString,
+ GHC.Exts.IsList,
+
+ System.IO.hPutStrLn,
+ System.IO.hPutStr,
+ System.IO.hPutChar,
+ System.IO.hPrint,
+ System.IO.stdout,
+ System.IO.stderr,
+ System.IO.stdin,
+ System.IO.getChar,
+ System.IO.getLine,
+ System.IO.writeFile,
+ System.IO.Handle,
+
+ System.IO.Strict.readFile,
+ System.IO.Strict.getContents,
+ System.IO.Strict.hGetContents,
+
+ Control.Exception.catch,
+ Control.Exception.SomeException,
+
+ Control.Applicative.Applicative(..),
+ Control.Applicative.ZipList(..),
+ (Control.Applicative.<$>),
+
+ Control.Concurrent.MVar.MVar,
+ Control.Concurrent.MVar.newMVar,
+ Control.Concurrent.MVar.newEmptyMVar,
+ Control.Concurrent.MVar.isEmptyMVar,
+ Control.Concurrent.MVar.readMVar,
+ Control.Concurrent.MVar.takeMVar,
+ Control.Concurrent.MVar.putMVar,
+ Control.Concurrent.MVar.modifyMVar,
+ Control.Concurrent.MVar.modifyMVar_,
+
+ Data.IORef.IORef,
+ Data.IORef.readIORef,
+ Data.IORef.writeIORef,
+ Data.IORef.modifyIORef',
+ Data.IORef.newIORef,
+
+
+
+ -- Miscellaneous names
+ Data.Map.Map,
+ GHC.IO.FilePath,
+ Data.Text.Text,
+ Data.ByteString.ByteString,
+ Text.Printf.printf,
+ Data.Function.on,
+ ) where
+
+import Prelude
+
+import Data.Monoid as X
+import Data.Tuple as X
+import Control.Monad as X
+import Data.Maybe as X
+import Data.Either as X
+import Control.Monad.IO.Class as X
+import Data.Ord as X
+import GHC.Show as X
+import GHC.Enum as X
+import GHC.Num as X
+import GHC.Real as X
+import GHC.Base as X hiding (Any)
+import Data.List as X hiding (head, last, tail, init, transpose, subsequences, permutations,
+ foldl, foldl1, maximum, minimum, scanl, scanl1, scanr, scanr1, span, break,
+ mapAccumL, mapAccumR, dropWhileEnd, (!!), elemIndices,
+ elemIndex, findIndex, findIndices, zip5, zip6, zip7, zipWith5,
+ zipWith6, zipWith7, unzip5, unzip6, unzip6, delete, union, lookup,
+ intersect, insert, deleteBy, deleteFirstBy, unionBy,
+ intersectBy, group, groupBy, insertBy, maximumBy, minimumBy,
+ genericLength, genericDrop, genericTake, genericSplitAt,
+ genericIndex, genericReplicate, inits, tails)
+
+import qualified Control.Applicative
+import qualified Data.Typeable
+import qualified Data.IORef
+import qualified Data.Map
+import qualified Data.Text
+import qualified Data.Text.Lazy
+import qualified Data.ByteString
+import qualified Data.ByteString.Lazy
+import qualified Data.Function
+import qualified GHC.Exts
+import qualified System.IO
+import qualified System.IO.Strict
+import qualified GHC.IO
+import qualified Text.Printf
+import qualified Control.Exception
+import qualified Control.Concurrent.MVar
+
+import qualified Data.List
+import qualified Prelude as P
+
+type LByteString = Data.ByteString.Lazy.ByteString
+type LText = Data.Text.Lazy.Text
+
+(headMay, tailMay, lastMay, initMay, maximumMay, minimumMay) =
+ (wrapEmpty head, wrapEmpty tail, wrapEmpty last, wrapEmpty init, wrapEmpty maximum, wrapEmpty minimum)
+ where
+ wrapEmpty :: ([a] -> b) -> [a] -> Maybe b
+ wrapEmpty _ [] = Nothing
+ wrapEmpty f xs = Just (f xs)
+
+maximumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a
+maximumByMay _ [] = Nothing
+maximumByMay f xs = Just (Data.List.maximumBy f xs)
+
+minimumByMay :: (a -> a -> Ordering) -> [a] -> Maybe a
+minimumByMay _ [] = Nothing
+minimumByMay f xs = Just (Data.List.minimumBy f xs)
+
+readMay :: Read a => String -> Maybe a
+readMay = fmap fst . headMay . reads
+
+putStrLn :: (MonadIO m) => String -> m ()
+putStrLn = liftIO . P.putStrLn
+
+putStr :: (MonadIO m) => String -> m ()
+putStr = liftIO . P.putStr
+
+putChar:: MonadIO m => Char -> m ()
+putChar = liftIO . P.putChar
+
+print :: (MonadIO m, Show a) => a -> m ()
+print = liftIO . P.print
diff --git a/src/Main.hs b/src/Main.hs
index c7f61df3..db69043f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,22 +4,24 @@
-- Chans to communicate with the ZeroMQ sockets.
module Main (main) where
--- Prelude imports.
-import ClassyPrelude hiding (last, liftIO, readChan, writeChan)
-import Prelude (last, read)
+import IHaskellPrelude
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Char8 as CBS
-- Standard library imports.
import Control.Concurrent (threadDelay)
import Control.Concurrent.Chan
import Data.Aeson
-import Data.Text (strip)
import System.Directory
import System.Exit (exitSuccess)
-import Text.Printf
+import System.Environment (getArgs)
import System.Posix.Signals
import qualified Data.Map as Map
import Data.String.Here (hereFile)
-import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
-- IHaskell imports.
import IHaskell.Convert (convert)
@@ -33,7 +35,6 @@ import IHaskell.IPython
import IHaskell.Types
import IHaskell.IPython.ZeroMQ
import IHaskell.IPython.Types
-import qualified Data.ByteString.Char8 as Chars
import qualified IHaskell.IPython.Message.UUID as UUID
import qualified IHaskell.IPython.Stdin as Stdin
@@ -42,7 +43,7 @@ import GHC hiding (extensions, language)
-- | Compute the GHC API version number using the dist/build/autogen/cabal_macros.h
ghcVersionInts :: [Int]
-ghcVersionInts = map read . words . map dotToSpace $ VERSION_ghc
+ghcVersionInts = map (fromJust . readMay) . words . map dotToSpace $ VERSION_ghc
where
dotToSpace '.' = ' '
dotToSpace x = x
@@ -52,18 +53,18 @@ ihaskellCSS = [hereFile|html/custom.css|]
consoleBanner :: Text
consoleBanner =
- "Welcome to IHaskell! Run `IHaskell --help` for more information.\n" ++
+ "Welcome to IHaskell! Run `IHaskell --help` for more information.\n" <>
"Enter `:help` to learn more about IHaskell built-ins."
main :: IO ()
main = do
- args <- parseFlags <$> map unpack <$> getArgs
+ args <- parseFlags <$> getArgs
case args of
Left errorMessage -> hPutStrLn stderr errorMessage
Right args -> ihaskell args
ihaskell :: Args -> IO ()
-ihaskell (Args (ShowHelp help) _) = putStrLn $ pack help
+ihaskell (Args (ShowHelp help) _) = putStrLn help
ihaskell (Args ConvertLhs args) = showingHelp ConvertLhs args $ convert args
ihaskell (Args InstallKernelSpec args) = showingHelp InstallKernelSpec args $ do
let kernelSpecOpts = parseKernelArgs args
@@ -76,7 +77,7 @@ showingHelp :: IHaskellMode -> [Argument] -> IO () -> IO ()
showingHelp mode flags act =
case find (== Help) flags of
Just _ ->
- putStrLn $ pack $ help mode
+ putStrLn $ help mode
Nothing ->
act
@@ -101,7 +102,7 @@ runKernel kernelOpts profileSrc = do
libdir = kernelSpecGhcLibdir kernelOpts
-- Parse the profile file.
- Just profile <- liftM decode . readFile . fpFromString $ profileSrc
+ Just profile <- liftM decode $ LBS.readFile profileSrc
-- Necessary for `getLine` and their ilk to work.
dir <- getIHaskellDir
@@ -131,7 +132,7 @@ runKernel kernelOpts profileSrc = do
confFile <- liftIO $ kernelSpecConfFile kernelOpts
case confFile of
- Just filename -> liftIO (readFile $ fpFromString filename) >>= evaluator
+ Just filename -> liftIO (readFile filename) >>= evaluator
Nothing -> return ()
forever $ do
@@ -247,12 +248,14 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
header <- dupHeader replyHeader DisplayDataMessage
send $ PublishDisplayData header "haskell" $ map (convertSvgToHtml . prependCss) outs
- convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ encodeUtf8 svg
+ convertSvgToHtml (DisplayData MimeSvg svg) = html $ makeSvgImg $ base64 $ E.encodeUtf8 svg
convertSvgToHtml x = x
- makeSvgImg base64data = unpack $ "
"
+
+ makeSvgImg :: Base64 -> String
+ makeSvgImg base64data = T.unpack $ "
base64data <> "\"/>"
prependCss (DisplayData MimeHtml html) =
- DisplayData MimeHtml $concat ["", html]
+ DisplayData MimeHtml $ mconcat ["", html]
prependCss x = x
startComm :: CommInfo -> IO ()
@@ -304,10 +307,10 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
let execCount = getExecutionCounter state
-- Let all frontends know the execution count and code that's about to run
inputHeader <- liftIO $ dupHeader replyHeader InputMessage
- send $ PublishInput inputHeader (unpack code) execCount
+ send $ PublishInput inputHeader (T.unpack code) execCount
-- Run code and publish to the frontend as we go.
- updatedState <- evaluate state (unpack code) publish
+ updatedState <- evaluate state (T.unpack code) publish
-- Notify the frontend that we're done computing.
idleHeader <- liftIO $ dupHeader replyHeader StatusMessage
@@ -329,15 +332,15 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
replyTo _ req@CompleteRequest{} replyHeader state = do
let code = getCode req
pos = getCursorPos req
- (matchedText, completions) <- complete (unpack code) pos
+ (matchedText, completions) <- complete (T.unpack code) pos
let start = pos - length matchedText
end = pos
- reply = CompleteReply replyHeader (map pack completions) start end Map.empty True
+ reply = CompleteReply replyHeader (map T.pack completions) start end Map.empty True
return (state, reply)
replyTo _ req@InspectRequest{} replyHeader state = do
- result <- inspect (unpack $ inspectCode req) (inspectCursorPos req)
+ result <- inspect (T.unpack $ inspectCode req) (inspectCursorPos req)
let reply =
case result of
Just (Display datas) -> InspectReply
@@ -365,7 +368,7 @@ handleComm replier kernelState req replyHeader = do
communicate value = do
head <- dupHeader replyHeader CommDataMessage
replier $ CommData head uuid value
- case lookup uuid widgets of
+ case Map.lookup uuid widgets of
Nothing -> fail $ "no widget with uuid " ++ show uuid
Just (Widget widget) ->
case msgType $ header req of