{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
module Text.Markdown.Block
    ( Block (..)
    , ListType (..)
    , toBlocks
    , toBlockLines
    ) where

import Prelude
import Control.Monad (msum)
#if MIN_VERSION_conduit(1, 0, 0)
import Data.Conduit
#else
import Data.Conduit hiding ((.|))
import Data.Conduit.Internal (pipeL)
#endif
import qualified Data.Conduit.Text as CT
import qualified Data.Conduit.List as CL
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isDigit)
import Text.Markdown.Types
import qualified Data.Set as Set
import qualified Data.Map as Map

toBlockLines :: Block Text -> Block [Text]
toBlockLines :: Block Text -> Block [Text]
toBlockLines = (Text -> [Text]) -> Block Text -> Block [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> [Text]) -> Block Text -> Block [Text])
-> (Text -> [Text]) -> Block Text -> Block [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd
                    ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Text -> [Text]
T.splitOn Text
"  \r\n")
                    ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"  \n"

toBlocks :: Monad m => MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocks :: MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocks MarkdownSettings
ms =
    (Text -> Text)
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
mapOutput Text -> Text
fixWS ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
CT.lines ConduitT Text Text m ()
-> ConduitM Text (Block Text) m ()
-> ConduitM Text (Block Text) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MarkdownSettings -> ConduitM Text (Block Text) m ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms
  where
    fixWS :: Text -> Text
fixWS = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
go Int
0 (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

    go :: Int -> String -> String
go Int
_ [] = []
    go Int
i (Char
'\r':String
cs) = Int -> String -> String
go Int
i String
cs
    go Int
i (Char
'\t':String
cs) =
        (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
j Char
' ') String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) String
cs
      where
        j :: Int
j = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4)
    go Int
i (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
cs

toBlocksLines :: Monad m => MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines :: MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms = (Text -> ConduitT Text (Either Blank (Block Text)) m ())
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (MarkdownSettings
-> Text -> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings
-> Text -> ConduitM Text (Either Blank (Block Text)) m ()
start MarkdownSettings
ms) ConduitT Text (Either Blank (Block Text)) m ()
-> ConduitM (Either Blank (Block Text)) (Block Text) m ()
-> ConduitM Text (Block Text) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *).
Monad m =>
ConduitM (Either Blank (Block Text)) (Block Text) m ()
tightenLists

tightenLists :: Monad m => ConduitM (Either Blank (Block Text)) (Block Text) m ()
tightenLists :: ConduitM (Either Blank (Block Text)) (Block Text) m ()
tightenLists =
    Maybe (ListType, Bool)
-> ConduitM (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *).
Monad m =>
Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go Maybe (ListType, Bool)
forall a. Maybe a
Nothing
  where
    go :: Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go Maybe (ListType, Bool)
mTightList =
        ConduitT
  (Either Blank (Block Text))
  (Block Text)
  m
  (Maybe (Either Blank (Block Text)))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT
  (Either Blank (Block Text))
  (Block Text)
  m
  (Maybe (Either Blank (Block Text)))
-> (Maybe (Either Blank (Block Text))
    -> ConduitT (Either Blank (Block Text)) (Block Text) m ())
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT (Either Blank (Block Text)) (Block Text) m ()
-> (Either Blank (Block Text)
    -> ConduitT (Either Blank (Block Text)) (Block Text) m ())
-> Maybe (Either Blank (Block Text))
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Either Blank (Block Text)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go'
      where
        go' :: Either Blank (Block Text)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go' (Left Blank
Blank) = Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go Maybe (ListType, Bool)
mTightList
        go' (Right (BlockList ListType
ltNew Either Text [Block Text]
contents)) =
            case Maybe (ListType, Bool)
mTightList of
                Just (ltOld, isTight) | ListType
ltOld ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
== ListType
ltNew -> do
                    Block Text
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Block Text
 -> ConduitT (Either Blank (Block Text)) (Block Text) m ())
-> Block Text
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall a b. (a -> b) -> a -> b
$ ListType -> Either Text [Block Text] -> Block Text
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
ltNew (Either Text [Block Text] -> Block Text)
-> Either Text [Block Text] -> Block Text
forall a b. (a -> b) -> a -> b
$ (if Bool
isTight then Either Text [Block Text] -> Either Text [Block Text]
tighten else Either Text [Block Text] -> Either Text [Block Text]
forall a. Either a [Block a] -> Either a [Block a]
untighten) Either Text [Block Text]
contents
                    Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go Maybe (ListType, Bool)
mTightList
                Maybe (ListType, Bool)
_ -> do
                    Bool
isTight <- ListType
-> Bool -> ConduitT (Either Blank (Block Text)) (Block Text) m Bool
forall (m :: * -> *) inline o.
Monad m =>
ListType -> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
checkTight ListType
ltNew Bool
False
                    Block Text
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Block Text
 -> ConduitT (Either Blank (Block Text)) (Block Text) m ())
-> Block Text
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall a b. (a -> b) -> a -> b
$ ListType -> Either Text [Block Text] -> Block Text
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
ltNew (Either Text [Block Text] -> Block Text)
-> Either Text [Block Text] -> Block Text
forall a b. (a -> b) -> a -> b
$ (if Bool
isTight then Either Text [Block Text] -> Either Text [Block Text]
tighten else Either Text [Block Text] -> Either Text [Block Text]
forall a. Either a [Block a] -> Either a [Block a]
untighten) Either Text [Block Text]
contents
                    Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go (Maybe (ListType, Bool)
 -> ConduitT (Either Blank (Block Text)) (Block Text) m ())
-> Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall a b. (a -> b) -> a -> b
$ (ListType, Bool) -> Maybe (ListType, Bool)
forall a. a -> Maybe a
Just (ListType
ltNew, Bool
isTight)
        go' (Right Block Text
b) = Block Text
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Block Text
b ConduitT (Either Blank (Block Text)) (Block Text) m ()
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ListType, Bool)
-> ConduitT (Either Blank (Block Text)) (Block Text) m ()
go Maybe (ListType, Bool)
forall a. Maybe a
Nothing

    tighten :: Either Text [Block Text] -> Either Text [Block Text]
tighten (Right [BlockPara Text
t]) = Text -> Either Text [Block Text]
forall a b. a -> Either a b
Left Text
t
    tighten (Right []) = Text -> Either Text [Block Text]
forall a b. a -> Either a b
Left Text
T.empty
    tighten Either Text [Block Text]
x = Either Text [Block Text]
x

    untighten :: Either a [Block a] -> Either a [Block a]
untighten (Left a
t) = [Block a] -> Either a [Block a]
forall a b. b -> Either a b
Right [a -> Block a
forall inline. inline -> Block inline
BlockPara a
t]
    untighten Either a [Block a]
x = Either a [Block a]
x

    checkTight :: ListType -> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
checkTight ListType
lt Bool
sawBlank = do
        ConduitT
  (Either Blank (Block inline))
  o
  m
  (Maybe (Either Blank (Block inline)))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT
  (Either Blank (Block inline))
  o
  m
  (Maybe (Either Blank (Block inline)))
-> (Maybe (Either Blank (Block inline))
    -> ConduitT (Either Blank (Block inline)) o m Bool)
-> ConduitT (Either Blank (Block inline)) o m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT (Either Blank (Block inline)) o m Bool
-> (Either Blank (Block inline)
    -> ConduitT (Either Blank (Block inline)) o m Bool)
-> Maybe (Either Blank (Block inline))
-> ConduitT (Either Blank (Block inline)) o m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ConduitT (Either Blank (Block inline)) o m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ConduitT (Either Blank (Block inline)) o m Bool)
-> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
sawBlank) Either Blank (Block inline)
-> ConduitT (Either Blank (Block inline)) o m Bool
go'
      where
        go' :: Either Blank (Block inline)
-> ConduitT (Either Blank (Block inline)) o m Bool
go' (Left Blank
Blank) = ListType -> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
checkTight ListType
lt Bool
True
        go' b :: Either Blank (Block inline)
b@(Right (BlockList ListType
ltNext Either inline [Block inline]
_)) | ListType
ltNext ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
== ListType
lt = do
            Either Blank (Block inline)
-> ConduitT (Either Blank (Block inline)) o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either Blank (Block inline)
b
            Bool -> ConduitT (Either Blank (Block inline)) o m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ConduitT (Either Blank (Block inline)) o m Bool)
-> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
sawBlank
        go' Either Blank (Block inline)
b = Either Blank (Block inline)
-> ConduitT (Either Blank (Block inline)) o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either Blank (Block inline)
b ConduitT (Either Blank (Block inline)) o m ()
-> ConduitT (Either Blank (Block inline)) o m Bool
-> ConduitT (Either Blank (Block inline)) o m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ConduitT (Either Blank (Block inline)) o m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

data Blank = Blank

data LineType = LineList ListType Text
              | LineCode Text
              | LineFenced Text FencedHandler -- ^ terminator, language
              | LineBlockQuote Text
              | LineHeading Int Text
              | LineBlank
              | LineText Text
              | LineRule
              | LineHtml Text
              | LineReference Text Text -- ^ name, destination

lineType :: MarkdownSettings -> Text -> LineType
lineType :: MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms Text
t
    | Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t = LineType
LineBlank
    | Just (Text
term, FencedHandler
fh) <- [(Text, Text -> FencedHandler)]
-> Text -> Maybe (Text, FencedHandler)
forall b. [(Text, Text -> b)] -> Text -> Maybe (Text, b)
getFenced (Map Text (Text -> FencedHandler) -> [(Text, Text -> FencedHandler)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text (Text -> FencedHandler)
 -> [(Text, Text -> FencedHandler)])
-> Map Text (Text -> FencedHandler)
-> [(Text, Text -> FencedHandler)]
forall a b. (a -> b) -> a -> b
$ MarkdownSettings -> Map Text (Text -> FencedHandler)
msFencedHandlers MarkdownSettings
ms) Text
t = Text -> FencedHandler -> LineType
LineFenced Text
term FencedHandler
fh
    | Just Text
t' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"> " Text
t = Text -> LineType
LineBlockQuote Text
t'
    | Just (Int
level, Text
t') <- Text -> Maybe (Int, Text)
stripHeading Text
t = Int -> Text -> LineType
LineHeading Int
level Text
t'
    | Just Text
t' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"    " Text
t = Text -> LineType
LineCode Text
t'
    | Text -> Bool
isRule Text
t = LineType
LineRule
    | Text -> Bool
isHtmlStart Text
t = Text -> LineType
LineHtml Text
t
    | Just (ListType
ltype, Text
t') <- Text -> Maybe (ListType, Text)
listStart Text
t = ListType -> Text -> LineType
LineList ListType
ltype Text
t'
    | Just (Text
name, Text
dest) <- Text -> Maybe (Text, Text)
getReference Text
t = Text -> Text -> LineType
LineReference Text
name Text
dest
    | Bool
otherwise = Text -> LineType
LineText Text
t
  where
    getFenced :: [(Text, Text -> b)] -> Text -> Maybe (Text, b)
getFenced [] Text
_ = Maybe (Text, b)
forall a. Maybe a
Nothing
    getFenced ((Text
x, Text -> b
fh):[(Text, Text -> b)]
xs) Text
t'
        | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
x Text
t' = (Text, b) -> Maybe (Text, b)
forall a. a -> Maybe a
Just (Text
x, Text -> b
fh (Text -> b) -> Text -> b
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
rest)
        | Bool
otherwise = [(Text, Text -> b)] -> Text -> Maybe (Text, b)
getFenced [(Text, Text -> b)]
xs Text
t'

    isRule :: Text -> Bool
    isRule :: Text -> Bool
isRule =
        Text -> Bool
go (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
      where
        go :: Text -> Bool
go Text
"* * *" = Bool
True
        go Text
"***" = Bool
True
        go Text
"*****" = Bool
True
        go Text
"- - -" = Bool
True
        go Text
"---" = Bool
True
        go Text
"___" = Bool
True
        go Text
"_ _ _" = Bool
True
        go Text
t' = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
t') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5

    stripHeading :: Text -> Maybe (Int, Text)
    stripHeading :: Text -> Maybe (Int, Text)
stripHeading Text
t'
        | Text -> Bool
T.null Text
x = Maybe (Int, Text)
forall a. Maybe a
Nothing
        | Bool
otherwise = (Int, Text) -> Maybe (Int, Text)
forall a. a -> Maybe a
Just (Text -> Int
T.length Text
x, Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Text
y)
      where
        (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Text
t'

    getReference :: Text -> Maybe (Text, Text)
    getReference :: Text -> Maybe (Text, Text)
getReference Text
a = do
        Text
b <- Text -> Text -> Maybe Text
T.stripPrefix Text
"[" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
a
        let (Text
name, Text
c) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']') Text
b
        Text
d <- Text -> Text -> Maybe Text
T.stripPrefix Text
"]:" Text
c
        (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
name, Text -> Text
T.strip Text
d)

start :: Monad m => MarkdownSettings -> Text -> ConduitM Text (Either Blank (Block Text)) m ()
start :: MarkdownSettings
-> Text -> ConduitM Text (Either Blank (Block Text)) m ()
start MarkdownSettings
ms Text
t =
    LineType -> ConduitM Text (Either Blank (Block Text)) m ()
forall (m :: * -> *).
Monad m =>
LineType -> ConduitT Text (Either Blank (Block Text)) m ()
go (LineType -> ConduitM Text (Either Blank (Block Text)) m ())
-> LineType -> ConduitM Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms Text
t
  where
    go :: LineType -> ConduitT Text (Either Blank (Block Text)) m ()
go LineType
LineBlank = Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Blank -> Either Blank (Block Text)
forall a b. a -> Either a b
Left Blank
Blank
    go (LineFenced Text
term FencedHandler
fh) = do
        (Maybe Text
finished, [Text]
ls) <- (Text -> Bool)
-> ConduitM Text (Either Blank (Block Text)) m (Maybe Text, [Text])
forall (m :: * -> *) i o.
Monad m =>
(i -> Bool) -> ConduitM i o m (Maybe i, [i])
takeTillConsume (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
term)
        case Maybe Text
finished of
            Just Text
_ -> do
                let block :: [Block Text]
block =
                        case FencedHandler
fh of
                            FHRaw Text -> [Block Text]
fh' -> Text -> [Block Text]
fh' (Text -> [Block Text]) -> Text -> [Block Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
                            FHParsed [Block Text] -> [Block Text]
fh' -> [Block Text] -> [Block Text]
fh' ([Block Text] -> [Block Text]) -> [Block Text] -> [Block Text]
forall a b. (a -> b) -> a -> b
$ ConduitT () Void Identity [Block Text] -> [Block Text]
forall r. ConduitT () Void Identity r -> r
runConduitPure (ConduitT () Void Identity [Block Text] -> [Block Text])
-> ConduitT () Void Identity [Block Text] -> [Block Text]
forall a b. (a -> b) -> a -> b
$ (Text -> ConduitT () Text Identity ())
-> [Text] -> ConduitT () Text Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT () Text Identity ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [Text]
ls ConduitT () Text Identity ()
-> ConduitM Text Void Identity [Block Text]
-> ConduitT () Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MarkdownSettings -> ConduitM Text (Block Text) Identity ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms ConduitM Text (Block Text) Identity ()
-> ConduitM (Block Text) Void Identity [Block Text]
-> ConduitM Text Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Block Text) Void Identity [Block Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                (Block Text -> ConduitT Text (Either Blank (Block Text)) m ())
-> [Block Text] -> ConduitT Text (Either Blank (Block Text)) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> (Block Text -> Either Blank (Block Text))
-> Block Text
-> ConduitT Text (Either Blank (Block Text)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right) [Block Text]
block
            Maybe Text
Nothing -> (Text -> ConduitT Text (Either Blank (Block Text)) m ())
-> [Text] -> ConduitT Text (Either Blank (Block Text)) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT Text (Either Blank (Block Text)) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
' ' Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls)
    go (LineBlockQuote Text
t') = do
        [Text]
ls <- ConduitM Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
takeQuotes ConduitM Text Text m ()
-> ConduitM Text (Either Blank (Block Text)) m [Text]
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
        let blocks :: [Block Text]
blocks = ConduitT () Void Identity [Block Text] -> [Block Text]
forall r. ConduitT () Void Identity r -> r
runConduitPure (ConduitT () Void Identity [Block Text] -> [Block Text])
-> ConduitT () Void Identity [Block Text] -> [Block Text]
forall a b. (a -> b) -> a -> b
$ (Text -> ConduitT () Text Identity ())
-> [Text] -> ConduitT () Text Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT () Text Identity ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls) ConduitT () Text Identity ()
-> ConduitM Text Void Identity [Block Text]
-> ConduitT () Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MarkdownSettings -> ConduitM Text (Block Text) Identity ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms ConduitM Text (Block Text) Identity ()
-> ConduitM (Block Text) Void Identity [Block Text]
-> ConduitM Text Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Block Text) Void Identity [Block Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
        Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ [Block Text] -> Block Text
forall inline. [Block inline] -> Block inline
BlockQuote [Block Text]
blocks
    go (LineHeading Int
level Text
t') = Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Block Text
forall inline. Int -> inline -> Block inline
BlockHeading Int
level Text
t'
    go (LineCode Text
t') = do
        [Text]
ls <- Int -> ConduitM Text Text m ()
forall (m :: * -> *). Monad m => Int -> ConduitM Text Text m ()
getIndented Int
4 ConduitM Text Text m ()
-> ConduitM Text (Either Blank (Block Text)) m [Text]
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
        Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Block Text
forall inline. Maybe Text -> Text -> Block inline
BlockCode Maybe Text
forall a. Maybe a
Nothing (Text -> Block Text) -> Text -> Block Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls
    go LineType
LineRule = Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right Block Text
forall inline. Block inline
BlockRule
    go (LineHtml Text
t') = do
        if Text
t' Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` MarkdownSettings -> Set Text
msStandaloneHtml MarkdownSettings
ms
            then Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Text -> Block Text
forall inline. Text -> Block inline
BlockHtml Text
t'
            else do
                [Text]
ls <- (Text -> Bool) -> ConduitM Text Text m ()
forall (m :: * -> *) i. Monad m => (i -> Bool) -> ConduitM i i m ()
takeTill (Text -> Bool
T.null (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) ConduitM Text Text m ()
-> ConduitM Text (Either Blank (Block Text)) m [Text]
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Text -> Block Text
forall inline. Text -> Block inline
BlockHtml (Text -> Block Text) -> Text -> Block Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls
    go (LineList ListType
ltype Text
t') = do
        Maybe Text
t2 <- ConduitT Text (Either Blank (Block Text)) m (Maybe Text)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
        case (Text -> LineType) -> Maybe Text -> Maybe LineType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms) Maybe Text
t2 of
            -- If the next line is a non-indented text line, then we have a
            -- lazy list.
            Just (LineText Text
t2') | Text -> Bool
T.null ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t2') -> do
                Int -> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1
                -- Get all of the non-indented lines.
                let loop :: ([Text] -> b) -> ConduitT Text o m b
loop [Text] -> b
front = do
                        Maybe Text
x <- ConduitT Text o m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
                        case Maybe Text
x of
                            Maybe Text
Nothing -> b -> ConduitT Text o m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ConduitT Text o m b) -> b -> ConduitT Text o m b
forall a b. (a -> b) -> a -> b
$ [Text] -> b
front []
                            Just Text
y ->
                                case MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms Text
y of
                                    LineText Text
z -> ([Text] -> b) -> ConduitT Text o m b
loop ([Text] -> b
front ([Text] -> b) -> ([Text] -> [Text]) -> [Text] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
zText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:))
                                    LineType
_ -> Text -> ConduitT Text o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
y ConduitT Text o m () -> ConduitT Text o m b -> ConduitT Text o m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> ConduitT Text o m b
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> b
front [])
                [Text]
ls <- ([Text] -> [Text])
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) b o.
Monad m =>
([Text] -> b) -> ConduitT Text o m b
loop (\[Text]
rest -> (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
t2' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest)
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ ListType -> Either Text [Block Text] -> Block Text
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
ltype (Either Text [Block Text] -> Block Text)
-> Either Text [Block Text] -> Block Text
forall a b. (a -> b) -> a -> b
$ [Block Text] -> Either Text [Block Text]
forall a b. b -> Either a b
Right [Text -> Block Text
forall inline. inline -> Block inline
BlockPara (Text -> Block Text) -> Text -> Block Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls]
            -- If the next line is an indented list, then we have a sublist. I
            -- disagree with this interpretation of Markdown, but it's the way
            -- that Github implements things, so we will too.
            Maybe LineType
_ | Just Text
t2' <- Maybe Text
t2
              , Just Text
t2'' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"    " Text
t2'
              , LineList ListType
_ltype' Text
_t2''' <- MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms Text
t2'' -> do
                [Text]
ls <- Int -> ConduitM Text Text m ()
forall (m :: * -> *). Monad m => Int -> ConduitM Text Text m ()
getIndented Int
4 ConduitM Text Text m ()
-> ConduitM Text (Either Blank (Block Text)) m [Text]
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                let blocks :: [Block Text]
blocks = ConduitT () Void Identity [Block Text] -> [Block Text]
forall r. ConduitT () Void Identity r -> r
runConduitPure (ConduitT () Void Identity [Block Text] -> [Block Text])
-> ConduitT () Void Identity [Block Text] -> [Block Text]
forall a b. (a -> b) -> a -> b
$ (Text -> ConduitT () Text Identity ())
-> [Text] -> ConduitT () Text Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT () Text Identity ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [Text]
ls ConduitT () Text Identity ()
-> ConduitM Text Void Identity [Block Text]
-> ConduitT () Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MarkdownSettings -> ConduitM Text (Block Text) Identity ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms ConduitM Text (Block Text) Identity ()
-> ConduitM (Block Text) Void Identity [Block Text]
-> ConduitM Text Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Block Text) Void Identity [Block Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                let addPlainText :: [Block Text] -> [Block Text]
addPlainText
                        | Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t' = [Block Text] -> [Block Text]
forall a. a -> a
id
                        | Bool
otherwise = (Text -> Block Text
forall inline. inline -> Block inline
BlockPlainText (Text -> Text
T.strip Text
t')Block Text -> [Block Text] -> [Block Text]
forall a. a -> [a] -> [a]
:)
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ ListType -> Either Text [Block Text] -> Block Text
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
ltype (Either Text [Block Text] -> Block Text)
-> Either Text [Block Text] -> Block Text
forall a b. (a -> b) -> a -> b
$ [Block Text] -> Either Text [Block Text]
forall a b. b -> Either a b
Right ([Block Text] -> Either Text [Block Text])
-> [Block Text] -> Either Text [Block Text]
forall a b. (a -> b) -> a -> b
$ [Block Text] -> [Block Text]
addPlainText [Block Text]
blocks
            Maybe LineType
_ -> do
                let t'' :: Text
t'' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t'
                let leader :: Int
leader = Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t''
                [Text]
ls <- Int -> ConduitM Text Text m ()
forall (m :: * -> *). Monad m => Int -> ConduitM Text Text m ()
getIndented Int
leader ConduitM Text Text m ()
-> ConduitM Text (Either Blank (Block Text)) m [Text]
-> ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text (Either Blank (Block Text)) m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                let blocks :: [Block Text]
blocks = ConduitT () Void Identity [Block Text] -> [Block Text]
forall r. ConduitT () Void Identity r -> r
runConduitPure (ConduitT () Void Identity [Block Text] -> [Block Text])
-> ConduitT () Void Identity [Block Text] -> [Block Text]
forall a b. (a -> b) -> a -> b
$ (Text -> ConduitT () Text Identity ())
-> [Text] -> ConduitT () Text Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT () Text Identity ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Text
t'' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls) ConduitT () Text Identity ()
-> ConduitM Text Void Identity [Block Text]
-> ConduitT () Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MarkdownSettings -> ConduitM Text (Block Text) Identity ()
forall (m :: * -> *).
Monad m =>
MarkdownSettings -> ConduitM Text (Block Text) m ()
toBlocksLines MarkdownSettings
ms ConduitM Text (Block Text) Identity ()
-> ConduitM (Block Text) Void Identity [Block Text]
-> ConduitM Text Void Identity [Block Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Block Text) Void Identity [Block Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ ListType -> Either Text [Block Text] -> Block Text
forall inline.
ListType -> Either inline [Block inline] -> Block inline
BlockList ListType
ltype (Either Text [Block Text] -> Block Text)
-> Either Text [Block Text] -> Block Text
forall a b. (a -> b) -> a -> b
$ [Block Text] -> Either Text [Block Text]
forall a b. b -> Either a b
Right [Block Text]
blocks
    go (LineReference Text
x Text
y) = Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Block Text
forall inline. Text -> Text -> Block inline
BlockReference Text
x Text
y
    go (LineText Text
t') = do
        -- Check for underline headings
        let getUnderline :: Text -> Maybe Int
            getUnderline :: Text -> Maybe Int
getUnderline Text
s
                | Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Maybe Int
forall a. Maybe a
Nothing
                | (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
s = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
                | (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
s = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
                | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
        Maybe Text
t2 <- ConduitT Text (Either Blank (Block Text)) m (Maybe Text)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
        case Maybe Text
t2 Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
getUnderline of
            Just Int
level -> do
                Int -> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Block Text
forall inline. Int -> inline -> Block inline
BlockHeading Int
level Text
t'
            Maybe Int
Nothing -> do
                let listStartIndent :: Text -> Bool
listStartIndent Text
x =
                        case Text -> Maybe (ListType, Text)
listStart Text
x of
                            Just (ListType
_, Text
y) -> Int -> Text -> Text
T.take Int
2 Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"  "
                            Maybe (ListType, Text)
Nothing -> Bool
False
                    isNonPara :: LineType -> Bool
isNonPara LineType
LineBlank = Bool
True
                    isNonPara LineFenced{} = Bool
True
                    isNonPara LineBlockQuote{} = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MarkdownSettings -> Bool
msBlankBeforeBlockquote MarkdownSettings
ms
                    isNonPara LineHtml{} = Bool
True -- See example 95 in Common Markdown spec
                    isNonPara LineType
_ = Bool
False
                (Maybe Text
mfinal, [Text]
ls) <- (Text -> Bool)
-> ConduitM Text (Either Blank (Block Text)) m (Maybe Text, [Text])
forall (m :: * -> *) i o.
Monad m =>
(i -> Bool) -> ConduitM i o m (Maybe i, [i])
takeTillConsume (\Text
x -> LineType -> Bool
isNonPara (MarkdownSettings -> Text -> LineType
lineType MarkdownSettings
ms Text
x) Bool -> Bool -> Bool
|| Text -> Bool
listStartIndent Text
x)
                ConduitT Text (Either Blank (Block Text)) m ()
-> (Text -> ConduitT Text (Either Blank (Block Text)) m ())
-> Maybe Text
-> ConduitT Text (Either Blank (Block Text)) m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text (Either Blank (Block Text)) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Maybe Text
mfinal
                Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either Blank (Block Text)
 -> ConduitT Text (Either Blank (Block Text)) m ())
-> Either Blank (Block Text)
-> ConduitT Text (Either Blank (Block Text)) m ()
forall a b. (a -> b) -> a -> b
$ Block Text -> Either Blank (Block Text)
forall a b. b -> Either a b
Right (Block Text -> Either Blank (Block Text))
-> Block Text -> Either Blank (Block Text)
forall a b. (a -> b) -> a -> b
$ Text -> Block Text
forall inline. inline -> Block inline
BlockPara (Text -> Block Text) -> Text -> Block Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls

isHtmlStart :: T.Text -> Bool
-- Allow for up to three spaces before the opening tag.
isHtmlStart :: Text -> Bool
isHtmlStart Text
t | Text
"    " Text -> Text -> Bool
`T.isPrefixOf` Text
t = Bool
False
isHtmlStart Text
t =
    case Text -> Text -> Maybe Text
T.stripPrefix Text
"<" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t of
        Maybe Text
Nothing -> Bool
False
        Just Text
t' ->
            let (Text
name, Text
rest)
                    | Just Text
_ <- Text -> Text -> Maybe Text
T.stripPrefix Text
"!--" Text
t' = (Text
"--", Text
t')
                    | Bool
otherwise = (Char -> Bool) -> Text -> (Text, Text)
T.break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>') Text
t'
             in ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isValidTagName Text
name Bool -> Bool -> Bool
&&
                Bool -> Bool
not (Text -> Bool
T.null Text
name) Bool -> Bool -> Bool
&&
                (Bool -> Bool
not (Text
"/" Text -> Text -> Bool
`T.isPrefixOf` Text
rest) Bool -> Bool -> Bool
|| (Text
"/>" Text -> Text -> Bool
`T.isPrefixOf` Text
rest)))

                Bool -> Bool -> Bool
|| Text -> Bool
isPI Text
t' Bool -> Bool -> Bool
|| Text -> Bool
isCommentCData Text
t'
  where
    isValidTagName :: Char -> Bool
    isValidTagName :: Char -> Bool
isValidTagName Char
c =
        (Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
        (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
        (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
||
        (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Bool -> Bool -> Bool
||
        (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Bool -> Bool -> Bool
||
        (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Bool -> Bool -> Bool
||
        (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!')

    isPI :: Text -> Bool
isPI = (Text
"?" Text -> Text -> Bool
`T.isPrefixOf`)
    isCommentCData :: Text -> Bool
isCommentCData = (Text
"!" Text -> Text -> Bool
`T.isPrefixOf`)

takeTill :: Monad m => (i -> Bool) -> ConduitM i i m ()
takeTill :: (i -> Bool) -> ConduitM i i m ()
takeTill i -> Bool
f =
    ConduitM i i m ()
loop
  where
    loop :: ConduitM i i m ()
loop = ConduitT i i m (Maybe i)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT i i m (Maybe i)
-> (Maybe i -> ConduitM i i m ()) -> ConduitM i i m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM i i m ()
-> (i -> ConduitM i i m ()) -> Maybe i -> ConduitM i i m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM i i m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\i
x -> if i -> Bool
f i
x then () -> ConduitM i i m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else i -> ConduitM i i m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield i
x ConduitM i i m () -> ConduitM i i m () -> ConduitM i i m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM i i m ()
loop)

takeTillConsume
  :: Monad m
  => (i -> Bool)
  -> ConduitM i o m (Maybe i, [i])
takeTillConsume :: (i -> Bool) -> ConduitM i o m (Maybe i, [i])
takeTillConsume i -> Bool
f =
    ([i] -> [i]) -> ConduitM i o m (Maybe i, [i])
forall (m :: * -> *) c o.
Monad m =>
([i] -> c) -> ConduitT i o m (Maybe i, c)
loop [i] -> [i]
forall a. a -> a
id
  where
    loop :: ([i] -> c) -> ConduitT i o m (Maybe i, c)
loop [i] -> c
front = ConduitT i o m (Maybe i)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT i o m (Maybe i)
-> (Maybe i -> ConduitT i o m (Maybe i, c))
-> ConduitT i o m (Maybe i, c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT i o m (Maybe i, c)
-> (i -> ConduitT i o m (Maybe i, c))
-> Maybe i
-> ConduitT i o m (Maybe i, c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ((Maybe i, c) -> ConduitT i o m (Maybe i, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe i
forall a. Maybe a
Nothing, [i] -> c
front []))
        (\i
x ->
            if i -> Bool
f i
x
                then (Maybe i, c) -> ConduitT i o m (Maybe i, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> Maybe i
forall a. a -> Maybe a
Just i
x, [i] -> c
front [])
                else ([i] -> c) -> ConduitT i o m (Maybe i, c)
loop ([i] -> c
front ([i] -> c) -> ([i] -> [i]) -> [i] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i
xi -> [i] -> [i]
forall a. a -> [a] -> [a]
:))
        )

listStart :: Text -> Maybe (ListType, Text)
listStart :: Text -> Maybe (ListType, Text)
listStart Text
t0
    | Just Text
t' <- Text -> Maybe Text
stripUnorderedListSeparator Text
t = (ListType, Text) -> Maybe (ListType, Text)
forall a. a -> Maybe a
Just (ListType
Unordered, Text
t')
    | Just Text
t' <- Text -> Maybe Text
stripNumber Text
t, Just Text
t'' <- Text -> Maybe Text
stripOrderedListSeparator Text
t' = (ListType, Text) -> Maybe (ListType, Text)
forall a. a -> Maybe a
Just (ListType
Ordered, Text
t'')
    | Bool
otherwise = Maybe (ListType, Text)
forall a. Maybe a
Nothing
  where
    t :: Text
t = Text -> Text
T.stripStart Text
t0

stripNumber :: Text -> Maybe Text
stripNumber :: Text -> Maybe Text
stripNumber Text
x
    | Text -> Bool
T.null Text
y = Maybe Text
forall a. Maybe a
Nothing
    | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
z
  where
    (Text
y, Text
z) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit Text
x

stripUnorderedListSeparator :: Text -> Maybe Text
stripUnorderedListSeparator :: Text -> Maybe Text
stripUnorderedListSeparator =
  [Text] -> Text -> Maybe Text
stripPrefixChoice [Text
"* ", Text
"*\t", Text
"+ ", Text
"+\t", Text
"- ", Text
"-\t"]

stripOrderedListSeparator :: Text -> Maybe Text
stripOrderedListSeparator :: Text -> Maybe Text
stripOrderedListSeparator =
  [Text] -> Text -> Maybe Text
stripPrefixChoice [Text
". ", Text
".\t", Text
") ", Text
")\t"]

-- | Attempt to strip each of the prefixes in @xs@ from the start of @x@. As
-- soon as one matches, return the remainder of @x@. Prefixes are tried in
-- order. If none match, return @Nothing@.
stripPrefixChoice :: [Text] -> Text -> Maybe Text
stripPrefixChoice :: [Text] -> Text -> Maybe Text
stripPrefixChoice [Text]
xs Text
x = [Maybe Text] -> Maybe Text
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Maybe Text) -> Text -> Text -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Maybe Text
T.stripPrefix Text
x) [Text]
xs

getIndented :: Monad m => Int -> ConduitM Text Text m ()
getIndented :: Int -> ConduitM Text Text m ()
getIndented Int
leader =
    [Text] -> ConduitM Text Text m ()
forall (m :: * -> *). Monad m => [Text] -> ConduitT Text Text m ()
go []
  where
    go :: [Text] -> ConduitT Text Text m ()
go [Text]
blanks = ConduitT Text Text m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Text Text m (Maybe Text)
-> (Maybe Text -> ConduitT Text Text m ())
-> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text Text m ()
-> (Text -> ConduitT Text Text m ())
-> Maybe Text
-> ConduitT Text Text m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Text -> ConduitT Text Text m ())
-> [Text] -> ConduitT Text Text m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT Text Text m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover [Text]
blanks) ([Text] -> Text -> ConduitT Text Text m ()
go' [Text]
blanks)

    go' :: [Text] -> Text -> ConduitT Text Text m ()
go' [Text]
blanks Text
t
        | Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t = [Text] -> ConduitT Text Text m ()
go (Int -> Text -> Text
T.drop Int
leader Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
blanks)
        | Text -> Int
T.length Text
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
leader Bool -> Bool -> Bool
&& Text -> Bool
T.null (Text -> Text
T.strip Text
x) = do
            (Text -> ConduitT Text Text m ())
-> [Text] -> ConduitT Text Text m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ([Text] -> ConduitT Text Text m ())
-> [Text] -> ConduitT Text Text m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
blanks
            Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
y
            [Text] -> ConduitT Text Text m ()
go []
        | Bool
otherwise = (Text -> ConduitT Text Text m ())
-> [Text] -> ConduitT Text Text m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> ConduitT Text Text m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
blanks)
      where
        (Text
x, Text
y) = Int -> Text -> (Text, Text)
T.splitAt Int
leader Text
t

takeQuotes :: Monad m => ConduitM Text Text m ()
takeQuotes :: ConduitM Text Text m ()
takeQuotes =
    ConduitT Text Text m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Text Text m (Maybe Text)
-> (Maybe Text -> ConduitM Text Text m ())
-> ConduitM Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM Text Text m ()
-> (Text -> ConduitM Text Text m ())
-> Maybe Text
-> ConduitM Text Text m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM Text Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitM Text Text m ()
forall (m :: * -> *). Monad m => Text -> ConduitT Text Text m ()
go
  where
    go :: Text -> ConduitT Text Text m ()
go Text
"" = () -> ConduitT Text Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Text
">" = Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
"" ConduitT Text Text m ()
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
takeQuotes
    go Text
t
        | Just Text
t' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"> " Text
t = Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t' ConduitT Text Text m ()
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
takeQuotes
        | Bool
otherwise = Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t ConduitT Text Text m ()
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
takeQuotes