{-# LANGUAGE PatternGuards #-}
module Text.BlogLiterately.Ghci
(
ProcessInfo
, ghciEval
, withGhciProcess
, isLiterate
, stopGhci
, magic
, extract'
, extract
, breaks
, formatInlineGhci
) where
import Control.Arrow (first)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Data.Char (isSpace)
import Data.Functor ((<$>))
import Data.List (intercalate, isPrefixOf)
import Data.Text (Text)
import qualified Data.Text as T
import System.FilePath (takeFileName)
import System.IO
import qualified System.IO.Strict as Strict
import System.IO.Temp
import System.Process (ProcessHandle,
runInteractiveCommand,
waitForProcess)
import Data.List.Split
import Text.Pandoc (Block (CodeBlock), Pandoc,
bottomUpM)
import Text.BlogLiterately.Block (onTag)
type ProcessInfo = (Handle, Handle, Handle, ProcessHandle)
data GhciInput = GhciInput String (Maybe String)
deriving Int -> GhciInput -> ShowS
[GhciInput] -> ShowS
GhciInput -> String
(Int -> GhciInput -> ShowS)
-> (GhciInput -> String)
-> ([GhciInput] -> ShowS)
-> Show GhciInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhciInput] -> ShowS
$cshowList :: [GhciInput] -> ShowS
show :: GhciInput -> String
$cshow :: GhciInput -> String
showsPrec :: Int -> GhciInput -> ShowS
$cshowsPrec :: Int -> GhciInput -> ShowS
Show
data GhciOutput = OK String
| Unexpected String String
deriving Int -> GhciOutput -> ShowS
[GhciOutput] -> ShowS
GhciOutput -> String
(Int -> GhciOutput -> ShowS)
-> (GhciOutput -> String)
-> ([GhciOutput] -> ShowS)
-> Show GhciOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhciOutput] -> ShowS
$cshowList :: [GhciOutput] -> ShowS
show :: GhciOutput -> String
$cshow :: GhciOutput -> String
showsPrec :: Int -> GhciOutput -> ShowS
$cshowsPrec :: Int -> GhciOutput -> ShowS
Show
data GhciLine = GhciLine GhciInput GhciOutput
deriving Int -> GhciLine -> ShowS
[GhciLine] -> ShowS
GhciLine -> String
(Int -> GhciLine -> ShowS)
-> (GhciLine -> String) -> ([GhciLine] -> ShowS) -> Show GhciLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhciLine] -> ShowS
$cshowList :: [GhciLine] -> ShowS
show :: GhciLine -> String
$cshow :: GhciLine -> String
showsPrec :: Int -> GhciLine -> ShowS
$cshowsPrec :: Int -> GhciLine -> ShowS
Show
ghciEval :: GhciInput -> ReaderT ProcessInfo IO GhciOutput
ghciEval :: GhciInput -> ReaderT ProcessInfo IO GhciOutput
ghciEval (GhciInput String
expr Maybe String
expected) = do
(Handle
pin, Handle
pout, Handle
_, ProcessHandle
_) <- ReaderT ProcessInfo IO ProcessInfo
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let script :: String
script = String
"putStrLn " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
magic String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"putStrLn " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
magic String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
String
out <- IO String -> ReaderT ProcessInfo IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ReaderT ProcessInfo IO String)
-> IO String -> ReaderT ProcessInfo IO String
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStr Handle
pin String
script
Handle -> IO ()
hFlush Handle
pin
Handle -> IO String
extract' Handle
pout
let out' :: String
out' = ShowS
strip String
out
case Maybe String
expected of
Maybe String
Nothing -> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (GhciOutput -> ReaderT ProcessInfo IO GhciOutput)
-> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall a b. (a -> b) -> a -> b
$ String -> GhciOutput
OK String
out'
Just String
e
| String
out' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
e -> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (GhciOutput -> ReaderT ProcessInfo IO GhciOutput)
-> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall a b. (a -> b) -> a -> b
$ String -> GhciOutput
OK String
out'
| Bool
otherwise -> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (GhciOutput -> ReaderT ProcessInfo IO GhciOutput)
-> GhciOutput -> ReaderT ProcessInfo IO GhciOutput
forall a b. (a -> b) -> a -> b
$ String -> String -> GhciOutput
Unexpected String
out' String
e
withGhciProcess :: FilePath -> ReaderT ProcessInfo IO a -> IO a
withGhciProcess :: String -> ReaderT ProcessInfo IO a -> IO a
withGhciProcess String
f ReaderT ProcessInfo IO a
m = do
String
src <- String -> IO String
Strict.readFile String
f
let isLit :: Bool
isLit = String -> Bool
isLiterate String
src
String -> String -> (String -> IO a) -> IO a
forall a. String -> String -> (String -> IO a) -> IO a
withLiterateHashWorkaround String
f String
src ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
f' -> do
ProcessInfo
h <- String -> IO ProcessInfo
runInteractiveCommand (String -> IO ProcessInfo) -> String -> IO ProcessInfo
forall a b. (a -> b) -> a -> b
$ String
"ghci -v0 -ignore-dot-ghci "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
isLit then String
f' else String
"")
a
res <- ReaderT ProcessInfo IO a -> ProcessInfo -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ProcessInfo IO a
m ProcessInfo
h
ProcessInfo -> IO ()
stopGhci ProcessInfo
h
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
withLiterateHashWorkaround :: FilePath -> String -> (FilePath -> IO a) -> IO a
withLiterateHashWorkaround :: String -> String -> (String -> IO a) -> IO a
withLiterateHashWorkaround String
f String
src String -> IO a
k = do
let bad :: String -> Bool
bad = (String
"#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
b :: Bool
b = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
bad ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
src
case Bool
b of
Bool
False -> String -> IO a
k String
f
Bool
True -> String -> String -> (String -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
"" (ShowS
takeFileName String
f) ((String -> Handle -> IO a) -> IO a)
-> (String -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
f' Handle
h -> do
Handle -> String -> IO ()
hPutStr Handle
h ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
bad) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
src)
Handle -> IO ()
hClose Handle
h
String -> IO a
k String
f'
isLiterate :: String -> Bool
isLiterate :: String -> Bool
isLiterate = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"> " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
stopGhci :: ProcessInfo -> IO ()
stopGhci :: ProcessInfo -> IO ()
stopGhci (Handle
pin,Handle
_,Handle
_,ProcessHandle
pid) = do
Handle -> String -> IO ()
hPutStrLn Handle
pin String
":q"
Handle -> IO ()
hFlush Handle
pin
ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
magic :: String
magic :: String
magic = String
"!@#$^&*"
extract' :: Handle -> IO String
Handle
h = ([String] -> String) -> IO [String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
extract ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines) (Int -> IO [String]
readMagic Int
2)
where
readMagic :: Int -> IO [String]
readMagic :: Int -> IO [String]
readMagic Int
0 = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
readMagic Int
n = do
String
l <- Handle -> IO String
hGetLine Handle
h
let n' :: Int
n' | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> String -> (String, String)
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
breaks (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
magic)) String
l = Int
n
| Bool
otherwise = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) (Int -> IO [String]
readMagic Int
n')
extract :: String -> String
String
s = String
v
where (String
t, String
u) = (String -> Bool) -> String -> (String, String)
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
breaks (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
magic) String
s
pre :: String
pre = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
t
prelength :: Int
prelength = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pre then Int
0 else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
u' :: String
u' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
magic Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prelength) String
u
(String
v, String
_) = (String -> Bool) -> String -> (String, String)
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
breaks (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
magic)) String
u'
breaks :: ([a] -> Bool) -> [a] -> ([a], [a])
breaks :: ([a] -> Bool) -> [a] -> ([a], [a])
breaks [a] -> Bool
_ [] = ([], [])
breaks [a] -> Bool
p as :: [a]
as@(a
a : [a]
as')
| [a] -> Bool
p [a]
as = ([], [a]
as)
| Bool
otherwise = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
breaks [a] -> Bool
p [a]
as'
formatInlineGhci :: FilePath -> Pandoc -> IO Pandoc
formatInlineGhci :: String -> Pandoc -> IO Pandoc
formatInlineGhci String
f = String -> ReaderT ProcessInfo IO Pandoc -> IO Pandoc
forall a. String -> ReaderT ProcessInfo IO a -> IO a
withGhciProcess String
f (ReaderT ProcessInfo IO Pandoc -> IO Pandoc)
-> (Pandoc -> ReaderT ProcessInfo IO Pandoc) -> Pandoc -> IO Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT ProcessInfo IO Block)
-> Pandoc -> ReaderT ProcessInfo IO Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM Block -> ReaderT ProcessInfo IO Block
formatInlineGhci'
where
formatInlineGhci' :: Block -> ReaderT ProcessInfo IO Block
formatInlineGhci' :: Block -> ReaderT ProcessInfo IO Block
formatInlineGhci' = Text
-> (Attr -> Text -> ReaderT ProcessInfo IO Block)
-> (Block -> ReaderT ProcessInfo IO Block)
-> Block
-> ReaderT ProcessInfo IO Block
forall a. Text -> (Attr -> Text -> a) -> (Block -> a) -> Block -> a
onTag (String -> Text
T.pack String
"ghci") Attr -> Text -> ReaderT ProcessInfo IO Block
formatGhciBlock Block -> ReaderT ProcessInfo IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return
formatGhciBlock :: Attr -> Text -> ReaderT ProcessInfo IO Block
formatGhciBlock Attr
attr Text
src = do
let inputs :: [GhciInput]
inputs = Text -> [GhciInput]
parseGhciInputs Text
src
[GhciLine]
results <- (GhciInput -> GhciOutput -> GhciLine)
-> [GhciInput] -> [GhciOutput] -> [GhciLine]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith GhciInput -> GhciOutput -> GhciLine
GhciLine [GhciInput]
inputs ([GhciOutput] -> [GhciLine])
-> ReaderT ProcessInfo IO [GhciOutput]
-> ReaderT ProcessInfo IO [GhciLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GhciInput -> ReaderT ProcessInfo IO GhciOutput)
-> [GhciInput] -> ReaderT ProcessInfo IO [GhciOutput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GhciInput -> ReaderT ProcessInfo IO GhciOutput
ghciEval [GhciInput]
inputs
Block -> ReaderT ProcessInfo IO Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> ReaderT ProcessInfo IO Block)
-> Block -> ReaderT ProcessInfo IO Block
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Block
CodeBlock Attr
attr (Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
"\n") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (GhciLine -> Text) -> [GhciLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (GhciLine -> String) -> GhciLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhciLine -> String
formatGhciResult) [GhciLine]
results)
parseGhciInputs :: Text -> [GhciInput]
parseGhciInputs :: Text -> [GhciInput]
parseGhciInputs = ([String] -> GhciInput) -> [[String]] -> [GhciInput]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> GhciInput
mkGhciInput
([[String]] -> [GhciInput])
-> (Text -> [[String]]) -> Text -> [GhciInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter String -> [String] -> [[String]]
forall a. Splitter a -> [a] -> [[a]]
split
( Splitter String -> Splitter String
forall a. Splitter a -> Splitter a
dropInitBlank
(Splitter String -> Splitter String)
-> (Splitter String -> Splitter String)
-> Splitter String
-> Splitter String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter String -> Splitter String
forall a. Splitter a -> Splitter a
dropFinalBlank
(Splitter String -> Splitter String)
-> (Splitter String -> Splitter String)
-> Splitter String
-> Splitter String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splitter String -> Splitter String
forall a. Splitter a -> Splitter a
keepDelimsL
(Splitter String -> Splitter String)
-> Splitter String -> Splitter String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> Splitter String
forall a. (a -> Bool) -> Splitter a
whenElt (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
)
([String] -> [[String]])
-> (Text -> [String]) -> Text -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
(String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
mkGhciInput :: [String] -> GhciInput
mkGhciInput :: [String] -> GhciInput
mkGhciInput [] = String -> Maybe String -> GhciInput
GhciInput String
"" Maybe String
forall a. Maybe a
Nothing
mkGhciInput [String
i] = String -> Maybe String -> GhciInput
GhciInput String
i Maybe String
forall a. Maybe a
Nothing
mkGhciInput (String
i:[String]
expr) = String -> Maybe String -> GhciInput
GhciInput String
i (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines' ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
unindent ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String]
expr)
unlines' :: [String] -> String
unlines' :: [String] -> String
unlines' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
strip :: String -> String
strip :: ShowS
strip = ShowS
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
f
where f :: ShowS
f = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
unindent :: [String] -> [String]
unindent :: [String] -> [String]
unindent [] = []
unindent (String
x:[String]
xs) = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
indentAmt) (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
where indentAmt :: Int
indentAmt = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
x
indent :: Int -> String -> String
indent :: Int -> ShowS
indent Int
n = [String] -> String
unlines' ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' 'String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
colored, coloredBlock :: String -> String -> String
colored :: String -> ShowS
colored String
color String
txt = String
"<span style=\"color: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
color String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";\">" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</span>"
coloredBlock :: String -> ShowS
coloredBlock String
color = [String] -> String
unlines' ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
colored String
color) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
ghciPrompt :: String
ghciPrompt :: String
ghciPrompt = String -> ShowS
colored String
"gray" String
"ghci> "
formatGhciResult :: GhciLine -> String
formatGhciResult :: GhciLine -> String
formatGhciResult (GhciLine (GhciInput String
input Maybe String
_) (OK String
output))
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
output
= String
ghciPrompt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
esc String
input
| Bool
otherwise
= String
ghciPrompt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
esc String
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
indent Int
2 (ShowS
esc String
output) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
formatGhciResult (GhciLine (GhciInput String
input Maybe String
_) (Unexpected String
output String
expr))
= String
ghciPrompt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
esc String
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
indent Int
2 (String -> ShowS
coloredBlock String
"red" (ShowS
esc String
output))
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
indent Int
2 (String -> ShowS
coloredBlock String
"blue" (ShowS
esc String
expr))
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
esc :: String -> String
esc :: ShowS
esc = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeOne
where
escapeOne :: Char -> String
escapeOne Char
'<' = String
"<"
escapeOne Char
'>' = String
">"
escapeOne Char
c = [Char
c]