{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Parse (
  Module (..)
, DocTest (..)
, Expression
, ExpectedResult
, ExpectedLine (..)
, LineChunk (..)
, extractDocTests
, parseModules

#ifdef TEST
, parseInteractions
, parseProperties
, mkLineChunks
#endif
) where

import           Imports

import           Data.Char (isSpace)
import           Data.List (isPrefixOf, stripPrefix)
import           Data.String
import           Extract
import           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
$c== :: DocTest -> DocTest -> Bool
== :: DocTest -> DocTest -> Bool
$c/= :: DocTest -> DocTest -> Bool
/= :: DocTest -> DocTest -> Bool
Eq, Int -> DocTest -> ShowS
[DocTest] -> ShowS
DocTest -> [Char]
(Int -> DocTest -> ShowS)
-> (DocTest -> [Char]) -> ([DocTest] -> ShowS) -> Show DocTest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocTest -> ShowS
showsPrec :: Int -> DocTest -> ShowS
$cshow :: DocTest -> [Char]
show :: DocTest -> [Char]
$cshowList :: [DocTest] -> ShowS
showList :: [DocTest] -> ShowS
Show)

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

instance IsString LineChunk where
    fromString :: [Char] -> LineChunk
fromString = [Char] -> LineChunk
LineChunk

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

instance IsString ExpectedLine where
    fromString :: [Char] -> ExpectedLine
fromString = [LineChunk] -> ExpectedLine
ExpectedLine ([LineChunk] -> ExpectedLine)
-> ([Char] -> [LineChunk]) -> [Char] -> ExpectedLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineChunk -> [LineChunk]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (LineChunk -> [LineChunk])
-> ([Char] -> LineChunk) -> [Char] -> [LineChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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.
--
-- @
-- extractDocTests = fmap `parseModules` . `extract`
-- @
extractDocTests  :: [String] -> IO [Module [Located DocTest]]  -- ^ Extracted 'DocTest's
extractDocTests :: [[Char]] -> IO [Module [Located DocTest]]
extractDocTests = ([Module (Located [Char])] -> [Module [Located DocTest]])
-> IO [Module (Located [Char])] -> IO [Module [Located DocTest]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Module (Located [Char])] -> [Module [Located DocTest]]
parseModules (IO [Module (Located [Char])] -> IO [Module [Located DocTest]])
-> ([[Char]] -> IO [Module (Located [Char])])
-> [[Char]]
-> IO [Module [Located DocTest]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> IO [Module (Located [Char])]
extract

parseModules :: [Module (Located String)] -> [Module [Located DocTest]]
parseModules :: [Module (Located [Char])] -> [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 [Char])] -> [Module [Located DocTest]])
-> [Module (Located [Char])]
-> [Module [Located DocTest]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module (Located [Char]) -> Module [Located DocTest])
-> [Module (Located [Char])] -> [Module [Located DocTest]]
forall a b. (a -> b) -> [a] -> [b]
map Module (Located [Char]) -> Module [Located DocTest]
parseModule
  where
    isEmpty :: Module a -> Bool
isEmpty (Module [Char]
_ Maybe a
setup [a]
tests) = [a] -> Bool
forall a. [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 [Char]) -> Module [Located DocTest]
parseModule Module (Located [Char])
m = case Located [Char] -> [Located DocTest]
parseComment (Located [Char] -> [Located DocTest])
-> Module (Located [Char]) -> Module [Located DocTest]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module (Located [Char])
m of
  Module [Char]
name Maybe [Located DocTest]
setup [[Located DocTest]]
tests -> [Char]
-> Maybe [Located DocTest]
-> [[Located DocTest]]
-> Module [Located DocTest]
forall a. [Char] -> Maybe a -> [a] -> Module a
Module [Char]
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 a. [a] -> 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 [Char] -> [Located DocTest]
parseComment Located [Char]
c = [Located DocTest]
properties [Located DocTest] -> [Located DocTest] -> [Located DocTest]
forall a. [a] -> [a] -> [a]
++ [Located DocTest]
examples
  where
    examples :: [Located DocTest]
examples   = (Located ([Char], [ExpectedLine]) -> Located DocTest)
-> [Located ([Char], [ExpectedLine])] -> [Located DocTest]
forall a b. (a -> b) -> [a] -> [b]
map ((([Char], [ExpectedLine]) -> DocTest)
-> Located ([Char], [ExpectedLine]) -> Located DocTest
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([Char], [ExpectedLine]) -> DocTest)
 -> Located ([Char], [ExpectedLine]) -> Located DocTest)
-> (([Char], [ExpectedLine]) -> DocTest)
-> Located ([Char], [ExpectedLine])
-> Located DocTest
forall a b. (a -> b) -> a -> b
$ ([Char] -> [ExpectedLine] -> DocTest)
-> ([Char], [ExpectedLine]) -> DocTest
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [ExpectedLine] -> DocTest
Example) (Located [Char] -> [Located ([Char], [ExpectedLine])]
parseInteractions Located [Char]
c)
    properties :: [Located DocTest]
properties = (Located [Char] -> Located DocTest)
-> [Located [Char]] -> [Located DocTest]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> DocTest) -> Located [Char] -> Located DocTest
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap          [Char] -> DocTest
Property) (Located [Char] -> [Located [Char]]
parseProperties   Located [Char]
c)

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

    go :: [Located [Char]] -> [Located [Char]]
go [Located [Char]]
xs = case (Located [Char] -> Bool) -> [Located [Char]] -> [Located [Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool)
-> (Located [Char] -> Bool) -> Located [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [Char] -> Bool
isPrompt) [Located [Char]]
xs of
      Located [Char]
prop:[Located [Char]]
rest -> ShowS
stripPrompt ShowS -> Located [Char] -> Located [Char]
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Located [Char]
prop Located [Char] -> [Located [Char]] -> [Located [Char]]
forall a. a -> [a] -> [a]
: [Located [Char]] -> [Located [Char]]
go [Located [Char]]
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 [Char] -> [Located ([Char], [ExpectedLine])]
parseInteractions (Located Location
loc [Char]
input) = [Located [Char]] -> [Located ([Char], [ExpectedLine])]
go ([Located [Char]] -> [Located ([Char], [ExpectedLine])])
-> [Located [Char]] -> [Located ([Char], [ExpectedLine])]
forall a b. (a -> b) -> a -> b
$ (Location -> [Char] -> Located [Char])
-> [Location] -> [[Char]] -> [Located [Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Location -> [Char] -> Located [Char]
forall a. Location -> a -> Located a
Located (Location -> [Location]
enumerate Location
loc) ([Char] -> [[Char]]
lines [Char]
input)
  where
    isPrompt :: Located String -> Bool
    isPrompt :: Located [Char] -> Bool
isPrompt = [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
">>>" ([Char] -> Bool)
-> (Located [Char] -> [Char]) -> Located [Char] -> 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 [Char] -> [Char]) -> Located [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [Char] -> [Char]
forall a. Located a -> a
unLoc

    isBlankLine :: Located String -> Bool
    isBlankLine :: Located [Char] -> Bool
isBlankLine  = [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> (Located [Char] -> [Char]) -> Located [Char] -> 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 [Char] -> [Char]) -> Located [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [Char] -> [Char]
forall a. Located a -> a
unLoc

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


    go :: [Located String] -> [Located Interaction]
    go :: [Located [Char]] -> [Located ([Char], [ExpectedLine])]
go [Located [Char]]
xs = case (Located [Char] -> Bool) -> [Located [Char]] -> [Located [Char]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool)
-> (Located [Char] -> Bool) -> Located [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located [Char] -> Bool
isPrompt) [Located [Char]]
xs of
      Located [Char]
prompt:[Located [Char]]
rest
       | [Char]
":{" : [[Char]]
_ <- [Char] -> [[Char]]
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 [Char] -> [Char]
forall a. Located a -> a
unLoc Located [Char]
prompt))),
         ([Located [Char]]
ys,[Located [Char]]
zs) <- (Located [Char] -> Bool)
-> [Located [Char]] -> ([Located [Char]], [Located [Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located [Char] -> Bool
isBlankLine [Located [Char]]
rest ->
          Located [Char]
-> [Located [Char]] -> Located ([Char], [ExpectedLine])
toInteraction Located [Char]
prompt [Located [Char]]
ys Located ([Char], [ExpectedLine])
-> [Located ([Char], [ExpectedLine])]
-> [Located ([Char], [ExpectedLine])]
forall a. a -> [a] -> [a]
: [Located [Char]] -> [Located ([Char], [ExpectedLine])]
go [Located [Char]]
zs

       | Bool
otherwise ->
        let
          ([Located [Char]]
ys,[Located [Char]]
zs) = (Located [Char] -> Bool)
-> [Located [Char]] -> ([Located [Char]], [Located [Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located [Char] -> Bool
isEndOfInteraction [Located [Char]]
rest
        in
          Located [Char]
-> [Located [Char]] -> Located ([Char], [ExpectedLine])
toInteraction Located [Char]
prompt [Located [Char]]
ys Located ([Char], [ExpectedLine])
-> [Located ([Char], [ExpectedLine])]
-> [Located ([Char], [ExpectedLine])]
forall a. a -> [a] -> [a]
: [Located [Char]] -> [Located ([Char], [ExpectedLine])]
go [Located [Char]]
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 [Char]
-> [Located [Char]] -> Located ([Char], [ExpectedLine])
toInteraction (Located Location
loc [Char]
x) [Located [Char]]
xs = Location
-> ([Char], [ExpectedLine]) -> Located ([Char], [ExpectedLine])
forall a. Location -> a -> Located a
Located Location
loc (([Char], [ExpectedLine]) -> Located ([Char], [ExpectedLine]))
-> ([Char], [ExpectedLine]) -> Located ([Char], [ExpectedLine])
forall a b. (a -> b) -> a -> b
$
  (
    (ShowS
strip   [Char]
cleanedE)  -- we do not care about leading and trailing
                        -- whitespace in expressions, so drop them
  , ([Char] -> ExpectedLine) -> [[Char]] -> [ExpectedLine]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ExpectedLine
mkExpectedLine [[Char]]
result_
  )
  where
    -- 1. drop trailing whitespace from the prompt, remember the prefix
    ([Char]
prefix, [Char]
e) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace [Char]
x
    ([Char]
ePrompt, [Char]
eRest) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 [Char]
e

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

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

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


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

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

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

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