{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Test.DocTest.Internal.Parse (
  Module (..)
, DocTest (..)
, Interaction
, Expression
, ExpectedResult
, ExpectedLine (..)
, LineChunk (..)
, getDocTests

-- * exported for testing
, parseInteractions
, parseProperties
, mkLineChunks
) where

import           Data.Char (isSpace)
import           Data.List
import           Data.Maybe
import           Data.String

import           Test.DocTest.Internal.Extract
import           Test.DocTest.Internal.Location


data DocTest = Example Expression ExpectedResult | Property Expression
  deriving (DocTest -> DocTest -> Bool
(DocTest -> DocTest -> Bool)
-> (DocTest -> DocTest -> Bool) -> Eq DocTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocTest -> DocTest -> Bool
$c/= :: DocTest -> DocTest -> Bool
== :: DocTest -> DocTest -> Bool
$c== :: DocTest -> DocTest -> Bool
Eq, Int -> DocTest -> ShowS
[DocTest] -> ShowS
DocTest -> String
(Int -> DocTest -> ShowS)
-> (DocTest -> String) -> ([DocTest] -> ShowS) -> Show DocTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocTest] -> ShowS
$cshowList :: [DocTest] -> ShowS
show :: DocTest -> String
$cshow :: DocTest -> String
showsPrec :: Int -> DocTest -> ShowS
$cshowsPrec :: Int -> DocTest -> ShowS
Show)

data LineChunk = LineChunk String | WildCardChunk
  deriving (Int -> LineChunk -> ShowS
[LineChunk] -> ShowS
LineChunk -> String
(Int -> LineChunk -> ShowS)
-> (LineChunk -> String)
-> ([LineChunk] -> ShowS)
-> Show LineChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineChunk] -> ShowS
$cshowList :: [LineChunk] -> ShowS
show :: LineChunk -> String
$cshow :: LineChunk -> String
showsPrec :: Int -> LineChunk -> ShowS
$cshowsPrec :: Int -> LineChunk -> ShowS
Show, LineChunk -> LineChunk -> Bool
(LineChunk -> LineChunk -> Bool)
-> (LineChunk -> LineChunk -> Bool) -> Eq LineChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineChunk -> LineChunk -> Bool
$c/= :: LineChunk -> LineChunk -> Bool
== :: LineChunk -> LineChunk -> Bool
$c== :: LineChunk -> LineChunk -> Bool
Eq)

instance IsString LineChunk where
    fromString :: String -> LineChunk
fromString = String -> LineChunk
LineChunk

data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
  deriving (Int -> ExpectedLine -> ShowS
ExpectedResult -> ShowS
ExpectedLine -> String
(Int -> ExpectedLine -> ShowS)
-> (ExpectedLine -> String)
-> (ExpectedResult -> ShowS)
-> Show ExpectedLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: ExpectedResult -> ShowS
$cshowList :: ExpectedResult -> ShowS
show :: ExpectedLine -> String
$cshow :: ExpectedLine -> String
showsPrec :: Int -> ExpectedLine -> ShowS
$cshowsPrec :: Int -> ExpectedLine -> ShowS
Show, ExpectedLine -> ExpectedLine -> Bool
(ExpectedLine -> ExpectedLine -> Bool)
-> (ExpectedLine -> ExpectedLine -> Bool) -> Eq ExpectedLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectedLine -> ExpectedLine -> Bool
$c/= :: ExpectedLine -> ExpectedLine -> Bool
== :: ExpectedLine -> ExpectedLine -> Bool
$c== :: ExpectedLine -> ExpectedLine -> Bool
Eq)

instance IsString ExpectedLine where
    fromString :: String -> ExpectedLine
fromString = [LineChunk] -> ExpectedLine
ExpectedLine ([LineChunk] -> ExpectedLine)
-> (String -> [LineChunk]) -> String -> ExpectedLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineChunk -> [LineChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return (LineChunk -> [LineChunk])
-> (String -> LineChunk) -> String -> [LineChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LineChunk
LineChunk

type Expression = String
type ExpectedResult = [ExpectedLine]

type Interaction = (Expression, ExpectedResult)


-- |
-- Extract 'DocTest's from all given modules and all modules included by the
-- given modules.
getDocTests :: [String] -> IO [Module [Located DocTest]]  -- ^ Extracted 'DocTest's
getDocTests :: [String] -> IO [Module [Located DocTest]]
getDocTests [String]
args = [Module (Located String)] -> [Module [Located DocTest]]
parseModules ([Module (Located String)] -> [Module [Located DocTest]])
-> IO [Module (Located String)] -> IO [Module [Located DocTest]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO [Module (Located String)]
extract [String]
args

parseModules :: [Module (Located String)] -> [Module [Located DocTest]]
parseModules :: [Module (Located String)] -> [Module [Located DocTest]]
parseModules = (Module [Located DocTest] -> Bool)
-> [Module [Located DocTest]] -> [Module [Located DocTest]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Module [Located DocTest] -> Bool)
-> Module [Located DocTest]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module [Located DocTest] -> Bool
forall {a}. Module a -> Bool
isEmpty) ([Module [Located DocTest]] -> [Module [Located DocTest]])
-> ([Module (Located String)] -> [Module [Located DocTest]])
-> [Module (Located String)]
-> [Module [Located DocTest]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module (Located String) -> Module [Located DocTest])
-> [Module (Located String)] -> [Module [Located DocTest]]
forall a b. (a -> b) -> [a] -> [b]
map Module (Located String) -> Module [Located DocTest]
parseModule
  where
    isEmpty :: Module a -> Bool
isEmpty (Module String
_ Maybe a
setup [a]
tests) = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tests Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
setup

-- | Convert documentation to `Example`s.
parseModule :: Module (Located String) -> Module [Located DocTest]
parseModule :: Module (Located String) -> Module [Located DocTest]
parseModule Module (Located String)
m = case Located String -> [Located DocTest]
parseComment (Located String -> [Located DocTest])
-> Module (Located String) -> Module [Located DocTest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module (Located String)
m of
  Module String
name Maybe [Located DocTest]
setup [[Located DocTest]]
tests -> String
-> Maybe [Located DocTest]
-> [[Located DocTest]]
-> Module [Located DocTest]
forall a. String -> Maybe a -> [a] -> Module a
Module String
name Maybe [Located DocTest]
setup_ (([Located DocTest] -> Bool)
-> [[Located DocTest]] -> [[Located DocTest]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([Located DocTest] -> Bool) -> [Located DocTest] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located DocTest] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Located DocTest]]
tests)
    where
      setup_ :: Maybe [Located DocTest]
setup_ = case Maybe [Located DocTest]
setup of
        Just [] -> Maybe [Located DocTest]
forall a. Maybe a
Nothing
        Maybe [Located DocTest]
_       -> Maybe [Located DocTest]
setup

parseComment :: Located String -> [Located DocTest]
parseComment :: Located String -> [Located DocTest]
parseComment Located String
c = [Located DocTest]
properties [Located DocTest] -> [Located DocTest] -> [Located DocTest]
forall a. [a] -> [a] -> [a]
++ [Located DocTest]
examples
  where
    examples :: [Located DocTest]
examples   = (Located (String, ExpectedResult) -> Located DocTest)
-> [Located (String, ExpectedResult)] -> [Located DocTest]
forall a b. (a -> b) -> [a] -> [b]
map (((String, ExpectedResult) -> DocTest)
-> Located (String, ExpectedResult) -> Located DocTest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, ExpectedResult) -> DocTest)
 -> Located (String, ExpectedResult) -> Located DocTest)
-> ((String, ExpectedResult) -> DocTest)
-> Located (String, ExpectedResult)
-> Located DocTest
forall a b. (a -> b) -> a -> b
$ (String -> ExpectedResult -> DocTest)
-> (String, ExpectedResult) -> DocTest
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> ExpectedResult -> DocTest
Example) (Located String -> [Located (String, ExpectedResult)]
parseInteractions Located String
c)
    properties :: [Located DocTest]
properties = (Located String -> Located DocTest)
-> [Located String] -> [Located DocTest]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> DocTest) -> Located String -> Located DocTest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap          String -> DocTest
Property) (Located String -> [Located String]
parseProperties   Located String
c)

-- | Extract all properties from given Haddock comment.
parseProperties :: Located String -> [Located Expression]
parseProperties :: Located String -> [Located String]
parseProperties (Located Location
loc String
input) = [Located String] -> [Located String]
go ([Located String] -> [Located String])
-> [Located String] -> [Located String]
forall a b. (a -> b) -> a -> b
$ (Location -> String -> Located String)
-> [Location] -> [String] -> [Located String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Location -> String -> Located String
forall a. Location -> a -> Located a
Located (Location -> [Location]
enumerate Location
loc) (String -> [String]
lines String
input)
  where
    isPrompt :: Located String -> Bool
    isPrompt :: Located String -> Bool
isPrompt = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"prop>" (String -> Bool)
-> (Located String -> String) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> (Located String -> String) -> Located String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. Located a -> a
unLoc

    go :: [Located String] -> [Located String]
go [Located String]
xs = case (Located String -> Bool) -> [Located String] -> [Located String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool)
-> (Located String -> Bool) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> Bool
isPrompt) [Located String]
xs of
      Located String
prop:[Located String]
rest -> ShowS
stripPrompt ShowS -> Located String -> Located String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Located String
prop Located String -> [Located String] -> [Located String]
forall a. a -> [a] -> [a]
: [Located String] -> [Located String]
go [Located String]
rest
      [] -> []

    stripPrompt :: ShowS
stripPrompt = ShowS
strip ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
5 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Extract all interactions from given Haddock comment.
parseInteractions :: Located String -> [Located Interaction]
parseInteractions :: Located String -> [Located (String, ExpectedResult)]
parseInteractions (Located Location
loc String
input) = [Located String] -> [Located (String, ExpectedResult)]
go ([Located String] -> [Located (String, ExpectedResult)])
-> [Located String] -> [Located (String, ExpectedResult)]
forall a b. (a -> b) -> a -> b
$ (Location -> String -> Located String)
-> [Location] -> [String] -> [Located String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Location -> String -> Located String
forall a. Location -> a -> Located a
Located (Location -> [Location]
enumerate Location
loc) (String -> [String]
lines String
input)
  where
    isPrompt :: Located String -> Bool
    isPrompt :: Located String -> Bool
isPrompt = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
">>>" (String -> Bool)
-> (Located String -> String) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> (Located String -> String) -> Located String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. Located a -> a
unLoc

    isBlankLine :: Located String -> Bool
    isBlankLine :: Located String -> Bool
isBlankLine  = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> (Located String -> String) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> (Located String -> String) -> Located String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. Located a -> a
unLoc

    isEndOfInteraction :: Located String -> Bool
    isEndOfInteraction :: Located String -> Bool
isEndOfInteraction Located String
x = Located String -> Bool
isPrompt Located String
x Bool -> Bool -> Bool
|| Located String -> Bool
isBlankLine Located String
x


    go :: [Located String] -> [Located Interaction]
    go :: [Located String] -> [Located (String, ExpectedResult)]
go [Located String]
xs = case (Located String -> Bool) -> [Located String] -> [Located String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool)
-> (Located String -> Bool) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> Bool
isPrompt) [Located String]
xs of
      Located String
prompt:[Located String]
rest
       | String
":{" : [String]
_ <- String -> [String]
words (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Located String -> String
forall a. Located a -> a
unLoc Located String
prompt))),
         ([Located String]
ys,[Located String]
zs) <- (Located String -> Bool)
-> [Located String] -> ([Located String], [Located String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located String -> Bool
isBlankLine [Located String]
rest ->
          Located String
-> [Located String] -> Located (String, ExpectedResult)
toInteraction Located String
prompt [Located String]
ys Located (String, ExpectedResult)
-> [Located (String, ExpectedResult)]
-> [Located (String, ExpectedResult)]
forall a. a -> [a] -> [a]
: [Located String] -> [Located (String, ExpectedResult)]
go [Located String]
zs

       | Bool
otherwise ->
        let
          ([Located String]
ys,[Located String]
zs) = (Located String -> Bool)
-> [Located String] -> ([Located String], [Located String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located String -> Bool
isEndOfInteraction [Located String]
rest
        in
          Located String
-> [Located String] -> Located (String, ExpectedResult)
toInteraction Located String
prompt [Located String]
ys Located (String, ExpectedResult)
-> [Located (String, ExpectedResult)]
-> [Located (String, ExpectedResult)]
forall a. a -> [a] -> [a]
: [Located String] -> [Located (String, ExpectedResult)]
go [Located String]
zs
      [] -> []

-- | Create an `Interaction`, strip superfluous whitespace as appropriate.
--
-- also merge lines between :{ and :}, preserving whitespace inside
-- the block (since this is useful for avoiding {;}).
toInteraction :: Located String -> [Located String] -> Located Interaction
toInteraction :: Located String
-> [Located String] -> Located (String, ExpectedResult)
toInteraction (Located Location
loc String
x) [Located String]
xs = Location
-> (String, ExpectedResult) -> Located (String, ExpectedResult)
forall a. Location -> a -> Located a
Located Location
loc ((String, ExpectedResult) -> Located (String, ExpectedResult))
-> (String, ExpectedResult) -> Located (String, ExpectedResult)
forall a b. (a -> b) -> a -> b
$
  (
    (ShowS
strip   String
cleanedE)  -- we do not care about leading and trailing
                        -- whitespace in expressions, so drop them
  , (String -> ExpectedLine) -> [String] -> ExpectedResult
forall a b. (a -> b) -> [a] -> [b]
map String -> ExpectedLine
mkExpectedLine [String]
result_
  )
  where
    -- 1. drop trailing whitespace from the prompt, remember the prefix
    (String
prefix, String
e) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
x
    (String
ePrompt, String
eRest) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 String
e

    -- 2. drop, if possible, the exact same sequence of whitespace
    -- characters from each result line
    unindent :: String -> [Located String] -> [String]
unindent String
pre = (Located String -> String) -> [Located String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
tryStripPrefix String
pre ShowS -> (Located String -> String) -> Located String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. Located a -> a
unLoc)

    cleanBody :: Located String -> String
cleanBody Located String
line = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Located String -> String
forall a. Located a -> a
unLoc Located String
line)
                    (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
ePrompt ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Located String -> String
forall a. Located a -> a
unLoc Located String
line)))

    (String
cleanedE, [String]
result_)
            | ([Located String]
body , Located String
endLine : [Located String]
rest) <- (Located String -> Bool)
-> [Located String] -> ([Located String], [Located String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break
                    ( [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
(==) [String
":}"] ([String] -> Bool)
-> (Located String -> [String]) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> (Located String -> [String]) -> Located String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> (Located String -> String) -> Located String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
cleanBody)
                    [Located String]
xs
                = ([String] -> String
unlines (String
eRest String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Located String -> String) -> [Located String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Located String -> String
cleanBody [Located String]
body [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                [(Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Located String -> String
cleanBody Located String
endLine)]),
                        String -> [Located String] -> [String]
unindent ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace (Located String -> String
forall a. Located a -> a
unLoc Located String
endLine)) [Located String]
rest)
            | Bool
otherwise = (String
eRest, String -> [Located String] -> [String]
unindent String
prefix [Located String]
xs)


tryStripPrefix :: String -> String -> String
tryStripPrefix :: String -> ShowS
tryStripPrefix String
prefix String
ys = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
ys (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
ys

mkExpectedLine :: String -> ExpectedLine
mkExpectedLine :: String -> ExpectedLine
mkExpectedLine String
x = case String
x of
    String
"<BLANKLINE>" -> ExpectedLine
""
    String
"..." -> ExpectedLine
WildCardLine
    String
_ -> [LineChunk] -> ExpectedLine
ExpectedLine ([LineChunk] -> ExpectedLine) -> [LineChunk] -> ExpectedLine
forall a b. (a -> b) -> a -> b
$ String -> [LineChunk]
mkLineChunks String
x

mkLineChunks :: String -> [LineChunk]
mkLineChunks :: String -> [LineChunk]
mkLineChunks = (Int, String, [LineChunk]) -> [LineChunk]
finish ((Int, String, [LineChunk]) -> [LineChunk])
-> (String -> (Int, String, [LineChunk])) -> String -> [LineChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk]))
-> (Int, String, [LineChunk])
-> String
-> (Int, String, [LineChunk])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk])
go (Int
0, [], [])
  where
    mkChunk :: String -> [LineChunk]
    mkChunk :: String -> [LineChunk]
mkChunk String
"" = []
    mkChunk String
x  = [String -> LineChunk
LineChunk String
x]

    go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk])
    go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk])
go Char
'.' (Int
count, String
acc, [LineChunk]
res) = if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
          then (Int
0, String
"", LineChunk
WildCardChunk LineChunk -> [LineChunk] -> [LineChunk]
forall a. a -> [a] -> [a]
: String -> [LineChunk]
mkChunk String
acc [LineChunk] -> [LineChunk] -> [LineChunk]
forall a. [a] -> [a] -> [a]
++ [LineChunk]
res)
          else (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, String
acc, [LineChunk]
res)
    go Char
c   (Int
count, String
acc, [LineChunk]
res) = if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          then (Int
0, Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
count Char
'.' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
acc, [LineChunk]
res)
          else (Int
0, Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc, [LineChunk]
res)
    finish :: (Int, String, [LineChunk]) -> [LineChunk]
finish (Int
count, String
acc, [LineChunk]
res) = String -> [LineChunk]
mkChunk (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
count Char
'.' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
acc) [LineChunk] -> [LineChunk] -> [LineChunk]
forall a. [a] -> [a] -> [a]
++ [LineChunk]
res


-- | Remove leading and trailing whitespace.
strip :: String -> String
strip :: ShowS
strip = (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 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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