{-# LANGUAGE OverloadedStrings #-}
module Cheapskate.Parse (
markdown
) where
import Cheapskate.ParserCombinators
import Cheapskate.Util
import Cheapskate.Inlines
import Cheapskate.Types
import Data.Char hiding (Space)
import qualified Data.Set as Set
import Prelude hiding (takeWhile)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid
import Data.Foldable (toList)
import Data.Sequence ((|>), viewr, ViewR(..), singleton, Seq)
import qualified Data.Sequence as Seq
import Control.Monad.RWS
import Control.Applicative
import qualified Data.Map as M
import Data.List (intercalate)
import Debug.Trace
markdown :: Options -> Text -> Doc
markdown :: Options -> Text -> Doc
markdown Options
opts
| Options -> Bool
debug Options
opts = (\(Container, ReferenceMap)
x -> forall a. [Char] -> a -> a
trace (forall a. Show a => a -> [Char]
show (Container, ReferenceMap)
x) forall a b. (a -> b) -> a -> b
$ Options -> Blocks -> Doc
Doc Options
opts forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Container, ReferenceMap)
processLines
| Bool
otherwise = Options -> Blocks -> Doc
Doc Options
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Container, ReferenceMap) -> Blocks
processDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Container, ReferenceMap)
processLines
data ContainerStack =
ContainerStack Container [Container]
type LineNumber = Int
data Elt = C Container
| L LineNumber Leaf
deriving Int -> Elt -> ShowS
[Elt] -> ShowS
Elt -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Elt] -> ShowS
$cshowList :: [Elt] -> ShowS
show :: Elt -> [Char]
$cshow :: Elt -> [Char]
showsPrec :: Int -> Elt -> ShowS
$cshowsPrec :: Int -> Elt -> ShowS
Show
data Container = Container{
Container -> ContainerType
containerType :: ContainerType
, Container -> Seq Elt
children :: Seq Elt
}
data ContainerType = Document
| BlockQuote
| ListItem { ContainerType -> Int
markerColumn :: Int
, ContainerType -> Int
padding :: Int
, ContainerType -> ListType
listType :: ListType }
| FencedCode { ContainerType -> Int
startColumn :: Int
, ContainerType -> Text
fence :: Text
, ContainerType -> Text
info :: Text }
| IndentedCode
| RawHtmlBlock
| Reference
deriving (ContainerType -> ContainerType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainerType -> ContainerType -> Bool
$c/= :: ContainerType -> ContainerType -> Bool
== :: ContainerType -> ContainerType -> Bool
$c== :: ContainerType -> ContainerType -> Bool
Eq, Int -> ContainerType -> ShowS
[ContainerType] -> ShowS
ContainerType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ContainerType] -> ShowS
$cshowList :: [ContainerType] -> ShowS
show :: ContainerType -> [Char]
$cshow :: ContainerType -> [Char]
showsPrec :: Int -> ContainerType -> ShowS
$cshowsPrec :: Int -> ContainerType -> ShowS
Show)
instance Show Container where
show :: Container -> [Char]
show Container
c = forall a. Show a => a -> [Char]
show (Container -> ContainerType
containerType Container
c) forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
Int -> ShowS
nest Int
2 (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" (forall a b. (a -> b) -> [a] -> [b]
map Elt -> [Char]
showElt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Container -> Seq Elt
children Container
c))
nest :: Int -> String -> String
nest :: Int -> ShowS
nest Int
num = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Int -> a -> [a]
replicate Int
num Char
' ') forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
showElt :: Elt -> String
showElt :: Elt -> [Char]
showElt (C Container
c) = forall a. Show a => a -> [Char]
show Container
c
showElt (L Int
_ (TextLine Text
s)) = forall a. Show a => a -> [Char]
show Text
s
showElt (L Int
_ Leaf
lf) = forall a. Show a => a -> [Char]
show Leaf
lf
containerContinue :: Container -> Scanner
containerContinue :: Container -> Scanner
containerContinue Container
c =
case Container -> ContainerType
containerType Container
c of
ContainerType
BlockQuote -> Scanner
scanNonindentSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scanner
scanBlockquoteStart
ContainerType
IndentedCode -> Scanner
scanIndentSpace
FencedCode{startColumn :: ContainerType -> Int
startColumn = Int
col} ->
Int -> Scanner
scanSpacesToColumn Int
col
ContainerType
RawHtmlBlock -> forall a. Parser a -> Scanner
nfb Scanner
scanBlankline
li :: ContainerType
li@ListItem{} -> Scanner
scanBlankline
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do Int -> Scanner
scanSpacesToColumn
(ContainerType -> Int
markerColumn ContainerType
li forall a. Num a => a -> a -> a
+ Int
1)
Int -> (Char -> Bool) -> Parser Text
upToCountChars (ContainerType -> Int
padding ContainerType
li forall a. Num a => a -> a -> a
- Int
1)
(forall a. Eq a => a -> a -> Bool
==Char
' ')
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Reference{} -> forall a. Parser a -> Scanner
nfb Scanner
scanBlankline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall a. Parser a -> Scanner
nfb (Scanner
scanNonindentSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Scanner
scanReference)
ContainerType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE containerContinue #-}
containerStart :: Bool -> Parser ContainerType
containerStart :: Bool -> Parser ContainerType
containerStart Bool
_lastLineIsText = Scanner
scanNonindentSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( (ContainerType
BlockQuote forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner
scanBlockquoteStart)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ContainerType
parseListMarker
)
verbatimContainerStart :: Bool -> Parser ContainerType
verbatimContainerStart :: Bool -> Parser ContainerType
verbatimContainerStart Bool
lastLineIsText = Scanner
scanNonindentSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( Parser ContainerType
parseCodeFence
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
lastLineIsText) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ContainerType
IndentedCode forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Parser a -> Scanner
nfb Scanner
scanBlankline))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
lastLineIsText) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ContainerType
RawHtmlBlock forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner
parseHtmlBlockStart))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
lastLineIsText) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ContainerType
Reference forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner
scanReference))
)
data Leaf = TextLine Text
| BlankLine Text
| Int Text
| Int Text
| Rule
deriving (Int -> Leaf -> ShowS
[Leaf] -> ShowS
Leaf -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Leaf] -> ShowS
$cshowList :: [Leaf] -> ShowS
show :: Leaf -> [Char]
$cshow :: Leaf -> [Char]
showsPrec :: Int -> Leaf -> ShowS
$cshowsPrec :: Int -> Leaf -> ShowS
Show)
type ContainerM = RWS () ReferenceMap ContainerStack
closeStack :: ContainerM Container
closeStack :: ContainerM Container
closeStack = do
ContainerStack Container
top [Container]
rest <- forall s (m :: * -> *). MonadState s m => m s
get
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Container]
rest
then forall (m :: * -> *) a. Monad m => a -> m a
return Container
top
else ContainerM ()
closeContainer forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContainerM Container
closeStack
closeContainer :: ContainerM ()
closeContainer :: ContainerM ()
closeContainer = do
ContainerStack Container
top [Container]
rest <- forall s (m :: * -> *). MonadState s m => m s
get
case Container
top of
(Container Reference{} Seq Elt
cs'') ->
case forall a. Parser a -> Text -> Either ParseError a
parse Parser (Text, Text, Text)
pReference
(Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinLines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Elt -> Text
extractText forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs'') of
Right (Text
lab, Text
lnk, Text
tit) -> do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (forall k a. k -> a -> Map k a
M.singleton (Text -> Text
normalizeReference Text
lab) (Text
lnk, Text
tit))
case [Container]
rest of
(Container ContainerType
ct' Seq Elt
cs' : [Container]
rs) ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct' (Seq Elt
cs' forall a. Seq a -> a -> Seq a
|> Container -> Elt
C Container
top)) [Container]
rs
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left ParseError
_ ->
case [Container]
rest of
(Container
c:[Container]
cs) -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack Container
c [Container]
cs
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Container li :: ContainerType
li@ListItem{} Seq Elt
cs'') ->
case [Container]
rest of
(Container ContainerType
ct' Seq Elt
cs' : [Container]
rs) ->
case forall a. Seq a -> ViewR a
viewr Seq Elt
cs'' of
(Seq Elt
zs :> b :: Elt
b@(L Int
_ BlankLine{})) ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack
(if forall a. Seq a -> Bool
Seq.null Seq Elt
zs
then ContainerType -> Seq Elt -> Container
Container ContainerType
ct' (Seq Elt
cs' forall a. Seq a -> a -> Seq a
|> Container -> Elt
C (ContainerType -> Seq Elt -> Container
Container ContainerType
li Seq Elt
zs))
else ContainerType -> Seq Elt -> Container
Container ContainerType
ct' (Seq Elt
cs' forall a. Seq a -> a -> Seq a
|>
Container -> Elt
C (ContainerType -> Seq Elt -> Container
Container ContainerType
li Seq Elt
zs) forall a. Seq a -> a -> Seq a
|> Elt
b)) [Container]
rs
ViewR Elt
_ -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct' (Seq Elt
cs' forall a. Seq a -> a -> Seq a
|> Container -> Elt
C Container
top)) [Container]
rs
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Container
_ -> case [Container]
rest of
(Container ContainerType
ct' Seq Elt
cs' : [Container]
rs) ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct' (Seq Elt
cs' forall a. Seq a -> a -> Seq a
|> Container -> Elt
C Container
top)) [Container]
rs
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
addLeaf :: LineNumber -> Leaf -> ContainerM ()
addLeaf :: Int -> Leaf -> ContainerM ()
addLeaf Int
lineNum Leaf
lf = do
ContainerStack Container
top [Container]
rest <- forall s (m :: * -> *). MonadState s m => m s
get
case (Container
top, Leaf
lf) of
(Container ct :: ContainerType
ct@(ListItem{}) Seq Elt
cs, BlankLine{}) ->
case forall a. Seq a -> ViewR a
viewr Seq Elt
cs of
(Seq Elt
_ :> L Int
_ BlankLine{}) ->
ContainerM ()
closeContainer forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Leaf -> ContainerM ()
addLeaf Int
lineNum Leaf
lf
ViewR Elt
_ -> forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct (Seq Elt
cs forall a. Seq a -> a -> Seq a
|> Int -> Leaf -> Elt
L Int
lineNum Leaf
lf)) [Container]
rest
(Container ContainerType
ct Seq Elt
cs, Leaf
_) ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct (Seq Elt
cs forall a. Seq a -> a -> Seq a
|> Int -> Leaf -> Elt
L Int
lineNum Leaf
lf)) [Container]
rest
addContainer :: ContainerType -> ContainerM ()
addContainer :: ContainerType -> ContainerM ()
addContainer ContainerType
ct = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \(ContainerStack Container
top [Container]
rest) ->
Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct forall a. Monoid a => a
mempty) (Container
topforall a. a -> [a] -> [a]
:[Container]
rest)
processDocument :: (Container, ReferenceMap) -> Blocks
processDocument :: (Container, ReferenceMap) -> Blocks
processDocument (Container ContainerType
ct Seq Elt
cs, ReferenceMap
refmap) =
case ContainerType
ct of
ContainerType
Document -> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs)
ContainerType
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"top level container is not Document"
processElts :: ReferenceMap -> [Elt] -> Blocks
processElts :: ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
_ [] = forall a. Monoid a => a
mempty
processElts ReferenceMap
refmap (L Int
_lineNumber Leaf
lf : [Elt]
rest) =
case Leaf
lf of
TextLine Text
t -> forall a. a -> Seq a
singleton (Inlines -> Block
Para forall a b. (a -> b) -> a -> b
$ ReferenceMap -> Text -> Inlines
parseInlines ReferenceMap
refmap Text
txt) forall a. Semigroup a => a -> a -> a
<>
ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest'
where txt :: Text
txt = Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ [Text] -> Text
joinLines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripStart
forall a b. (a -> b) -> a -> b
$ Text
t forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Elt -> Text
extractText [Elt]
textlines
([Elt]
textlines, [Elt]
rest') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Elt -> Bool
isTextLine [Elt]
rest
isTextLine :: Elt -> Bool
isTextLine (L Int
_ (TextLine Text
_)) = Bool
True
isTextLine Elt
_ = Bool
False
BlankLine{} -> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
ATXHeader Int
lvl Text
t -> forall a. a -> Seq a
singleton (Int -> Inlines -> Block
Header Int
lvl forall a b. (a -> b) -> a -> b
$ ReferenceMap -> Text -> Inlines
parseInlines ReferenceMap
refmap Text
t) forall a. Semigroup a => a -> a -> a
<>
ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
SetextHeader Int
lvl Text
t -> forall a. a -> Seq a
singleton (Int -> Inlines -> Block
Header Int
lvl forall a b. (a -> b) -> a -> b
$ ReferenceMap -> Text -> Inlines
parseInlines ReferenceMap
refmap Text
t) forall a. Semigroup a => a -> a -> a
<>
ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
Leaf
Rule -> forall a. a -> Seq a
singleton Block
HRule forall a. Semigroup a => a -> a -> a
<> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
processElts ReferenceMap
refmap (C (Container ContainerType
ct Seq Elt
cs) : [Elt]
rest) =
case ContainerType
ct of
ContainerType
Document -> forall a. HasCallStack => [Char] -> a
error [Char]
"Document container found inside Document"
ContainerType
BlockQuote -> forall a. a -> Seq a
singleton (Blocks -> Block
Blockquote forall a b. (a -> b) -> a -> b
$ ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs)) forall a. Semigroup a => a -> a -> a
<>
ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
ListItem { listType :: ContainerType -> ListType
listType = ListType
listType' } ->
forall a. a -> Seq a
singleton (Bool -> ListType -> [Blocks] -> Block
List Bool
isTight ListType
listType' [Blocks]
items') forall a. Semigroup a => a -> a -> a
<> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest'
where xs :: [Elt]
xs = [Elt] -> [Elt]
takeListItems [Elt]
rest
rest' :: [Elt]
rest' = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Elt]
xs) [Elt]
rest
takeListItems :: [Elt] -> [Elt]
takeListItems
(C c :: Container
c@(Container ListItem { listType :: ContainerType -> ListType
listType = ListType
lt' } Seq Elt
_) : [Elt]
zs)
| ListType -> ListType -> Bool
listTypesMatch ListType
lt' ListType
listType' = Container -> Elt
C Container
c forall a. a -> [a] -> [a]
: [Elt] -> [Elt]
takeListItems [Elt]
zs
takeListItems (lf :: Elt
lf@(L Int
_ (BlankLine Text
_)) :
c :: Elt
c@(C (Container ListItem { listType :: ContainerType -> ListType
listType = ListType
lt' } Seq Elt
_)) : [Elt]
zs)
| ListType -> ListType -> Bool
listTypesMatch ListType
lt' ListType
listType' = Elt
lf forall a. a -> [a] -> [a]
: Elt
c forall a. a -> [a] -> [a]
: [Elt] -> [Elt]
takeListItems [Elt]
zs
takeListItems [Elt]
_ = []
listTypesMatch :: ListType -> ListType -> Bool
listTypesMatch (Bullet Char
c1) (Bullet Char
c2) = Char
c1 forall a. Eq a => a -> a -> Bool
== Char
c2
listTypesMatch (Numbered NumWrapper
w1 Int
_) (Numbered NumWrapper
w2 Int
_) = NumWrapper
w1 forall a. Eq a => a -> a -> Bool
== NumWrapper
w2
listTypesMatch ListType
_ ListType
_ = Bool
False
items :: [[Elt]]
items = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Container -> Maybe [Elt]
getItem (ContainerType -> Seq Elt -> Container
Container ContainerType
ct Seq Elt
cs forall a. a -> [a] -> [a]
: [Container
c | C Container
c <- [Elt]
xs])
getItem :: Container -> Maybe [Elt]
getItem (Container ListItem{} Seq Elt
cs') = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs'
getItem Container
_ = forall a. Maybe a
Nothing
items' :: [Blocks]
items' = forall a b. (a -> b) -> [a] -> [b]
map (ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap) [[Elt]]
items
isTight :: Bool
isTight = [Elt] -> Bool
tightListItem [Elt]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Elt] -> Bool
tightListItem [[Elt]]
items
FencedCode Int
_ Text
_ Text
info' -> forall a. a -> Seq a
singleton (CodeAttr -> Text -> Block
CodeBlock CodeAttr
attr Text
txt) forall a. Semigroup a => a -> a -> a
<>
ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
where txt :: Text
txt = [Text] -> Text
joinLines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Elt -> Text
extractText forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs
attr :: CodeAttr
attr = Text -> Text -> CodeAttr
CodeAttr Text
x (Text -> Text
T.strip Text
y)
(Text
x,Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
' ') Text
info'
ContainerType
IndentedCode -> forall a. a -> Seq a
singleton (CodeAttr -> Text -> Block
CodeBlock (Text -> Text -> CodeAttr
CodeAttr Text
"" Text
"") Text
txt)
forall a. Semigroup a => a -> a -> a
<> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest'
where txt :: Text
txt = [Text] -> Text
joinLines forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
stripTrailingEmpties
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Elt -> [Text]
extractCode [Elt]
cbs
stripTrailingEmpties :: [Text] -> [Text]
stripTrailingEmpties = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
==Char
' ')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
extractCode :: Elt -> [Text]
extractCode (L Int
_ (BlankLine Text
t)) = [Int -> Text -> Text
T.drop Int
1 Text
t]
extractCode (C (Container ContainerType
IndentedCode Seq Elt
cs')) =
forall a b. (a -> b) -> [a] -> [b]
map Elt -> Text
extractText forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs'
extractCode Elt
_ = []
([Elt]
cbs, [Elt]
rest') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Elt -> Bool
isIndentedCodeOrBlank
(Container -> Elt
C (ContainerType -> Seq Elt -> Container
Container ContainerType
ct Seq Elt
cs) forall a. a -> [a] -> [a]
: [Elt]
rest)
isIndentedCodeOrBlank :: Elt -> Bool
isIndentedCodeOrBlank (L Int
_ BlankLine{}) = Bool
True
isIndentedCodeOrBlank (C (Container ContainerType
IndentedCode Seq Elt
_))
= Bool
True
isIndentedCodeOrBlank Elt
_ = Bool
False
ContainerType
RawHtmlBlock -> forall a. a -> Seq a
singleton (Text -> Block
HtmlBlock Text
txt) forall a. Semigroup a => a -> a -> a
<> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
where txt :: Text
txt = [Text] -> Text
joinLines (forall a b. (a -> b) -> [a] -> [b]
map Elt -> Text
extractText (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Elt
cs))
Reference{} -> ReferenceMap -> [Elt] -> Blocks
processElts ReferenceMap
refmap [Elt]
rest
where isBlankLine :: Elt -> Bool
isBlankLine (L Int
_ BlankLine{}) = Bool
True
isBlankLine Elt
_ = Bool
False
tightListItem :: [Elt] -> Bool
tightListItem [] = Bool
True
tightListItem [Elt]
xs = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Elt -> Bool
isBlankLine [Elt]
xs
extractText :: Elt -> Text
(L Int
_ (TextLine Text
t)) = Text
t
extractText Elt
_ = forall a. Monoid a => a
mempty
processLines :: Text -> (Container, ReferenceMap)
processLines :: Text -> (Container, ReferenceMap)
processLines Text
t = (Container
doc, ReferenceMap
refmap)
where
(Container
doc, ReferenceMap
refmap) = forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, Text) -> ContainerM ()
processLine [(Int, Text)]
lns forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContainerM Container
closeStack) () ContainerStack
startState
lns :: [(Int, Text)]
lns = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
tabFilter forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t)
startState :: ContainerStack
startState = Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
Document forall a. Monoid a => a
mempty) []
processLine :: (LineNumber, Text) -> ContainerM ()
processLine :: (Int, Text) -> ContainerM ()
processLine (Int
lineNumber, Text
txt) = do
ContainerStack top :: Container
top@(Container ContainerType
ct Seq Elt
cs) [Container]
rest <- forall s (m :: * -> *). MonadState s m => m s
get
let (Text
t', Int
numUnmatched) = [Container] -> Text -> (Text, Int)
tryOpenContainers (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Container
topforall a. a -> [a] -> [a]
:[Container]
rest) Text
txt
let lastLineIsText :: Bool
lastLineIsText = Int
numUnmatched forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
case forall a. Seq a -> ViewR a
viewr Seq Elt
cs of
(Seq Elt
_ :> L Int
_ (TextLine Text
_)) -> Bool
True
ViewR Elt
_ -> Bool
False
case ContainerType
ct of
RawHtmlBlock{} | Int
numUnmatched forall a. Eq a => a -> a -> Bool
== Int
0 -> Int -> Leaf -> ContainerM ()
addLeaf Int
lineNumber (Text -> Leaf
TextLine Text
t')
ContainerType
IndentedCode | Int
numUnmatched forall a. Eq a => a -> a -> Bool
== Int
0 -> Int -> Leaf -> ContainerM ()
addLeaf Int
lineNumber (Text -> Leaf
TextLine Text
t')
FencedCode{ fence :: ContainerType -> Text
fence = Text
fence' } ->
if Text
fence' Text -> Text -> Bool
`T.isPrefixOf` Text
t'
then ContainerM ()
closeContainer
else Int -> Leaf -> ContainerM ()
addLeaf Int
lineNumber (Text -> Leaf
TextLine Text
t')
ContainerType
_ -> case Bool -> Int -> Text -> ([ContainerType], Leaf)
tryNewContainers Bool
lastLineIsText (Text -> Int
T.length Text
txt forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t') Text
t' of
([], TextLine Text
t)
| Int
numUnmatched forall a. Ord a => a -> a -> Bool
> Int
0
, case forall a. Seq a -> ViewR a
viewr Seq Elt
cs of
(Seq Elt
_ :> L Int
_ (TextLine Text
_)) -> Bool
True
ViewR Elt
_ -> Bool
False
, ContainerType
ct forall a. Eq a => a -> a -> Bool
/= ContainerType
IndentedCode -> Int -> Leaf -> ContainerM ()
addLeaf Int
lineNumber (Text -> Leaf
TextLine Text
t)
([], SetextHeader Int
lev Text
_) | Int
numUnmatched forall a. Eq a => a -> a -> Bool
== Int
0 ->
case forall a. Seq a -> ViewR a
viewr Seq Elt
cs of
(Seq Elt
cs' :> L Int
_ (TextLine Text
t)) ->
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Container -> [Container] -> ContainerStack
ContainerStack (ContainerType -> Seq Elt -> Container
Container ContainerType
ct
(Seq Elt
cs' forall a. Seq a -> a -> Seq a
|> Int -> Leaf -> Elt
L Int
lineNumber (Int -> Text -> Leaf
SetextHeader Int
lev Text
t))) [Container]
rest
ViewR Elt
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"setext header line without preceding text line"
([ContainerType]
ns, Leaf
lf) -> do
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numUnmatched ContainerM ()
closeContainer
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ContainerType -> ContainerM ()
addContainer [ContainerType]
ns
case (forall a. [a] -> [a]
reverse [ContainerType]
ns, Leaf
lf) of
(FencedCode{}:[ContainerType]
_, BlankLine{}) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
([ContainerType], Leaf)
_ -> Int -> Leaf -> ContainerM ()
addLeaf Int
lineNumber Leaf
lf
tryOpenContainers :: [Container] -> Text -> (Text, Int)
tryOpenContainers :: [Container] -> Text -> (Text, Int)
tryOpenContainers [Container]
cs Text
t = case forall a. Parser a -> Text -> Either ParseError a
parse (forall {a}. [Parser a] -> Parser (Text, Int)
scanners forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Container -> Scanner
containerContinue [Container]
cs) Text
t of
Right (Text
t', Int
n) -> (Text
t', Int
n)
Left ParseError
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"error parsing scanners: " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show ParseError
e
where scanners :: [Parser a] -> Parser (Text, Int)
scanners [] = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
scanners (Parser a
p:[Parser a]
ps) = (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser a] -> Parser (Text, Int)
scanners [Parser a]
ps)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Parser a
pforall a. a -> [a] -> [a]
:[Parser a]
ps)))
tryNewContainers :: Bool -> Int -> Text -> ([ContainerType], Leaf)
tryNewContainers :: Bool -> Int -> Text -> ([ContainerType], Leaf)
tryNewContainers Bool
lastLineIsText Int
offset Text
t =
case forall a. Parser a -> Text -> Either ParseError a
parse Parser ([ContainerType], Leaf)
newContainers Text
t of
Right ([ContainerType]
cs,Leaf
t') -> ([ContainerType]
cs, Leaf
t')
Left ParseError
err -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show ParseError
err)
where newContainers :: Parser ([ContainerType], Leaf)
newContainers = do
Parser Position
getPosition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Position
pos -> Position -> Scanner
setPosition Position
pos{ column :: Int
column = Int
offset forall a. Num a => a -> a -> a
+ Int
1 }
[ContainerType]
regContainers <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Bool -> Parser ContainerType
containerStart Bool
lastLineIsText)
[ContainerType]
verbatimContainers <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option []
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
1 (Bool -> Parser ContainerType
verbatimContainerStart Bool
lastLineIsText)
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ContainerType]
verbatimContainers
then (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure [ContainerType]
regContainers forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Leaf
leaf Bool
lastLineIsText
else (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ContainerType]
regContainers forall a. [a] -> [a] -> [a]
++ [ContainerType]
verbatimContainers) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Parser Leaf
textLineOrBlank
textLineOrBlank :: Parser Leaf
textLineOrBlank :: Parser Leaf
textLineOrBlank = Text -> Leaf
consolidate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText
where consolidate :: Text -> Leaf
consolidate Text
ts | (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
==Char
' ') Text
ts = Text -> Leaf
BlankLine Text
ts
| Bool
otherwise = Text -> Leaf
TextLine Text
ts
leaf :: Bool -> Parser Leaf
leaf :: Bool -> Parser Leaf
leaf Bool
lastLineIsText = Scanner
scanNonindentSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (
(Int -> Text -> Leaf
ATXHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parseAtxHeaderStart forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeATXSuffix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
lastLineIsText forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Text -> Leaf
SetextHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parseSetextHeaderLine forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Leaf
Rule forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner
scanHRuleLine)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Leaf
textLineOrBlank
)
where removeATXSuffix :: Text -> Text
removeATXSuffix Text
t = case (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" #" :: String)) Text
t of
Text
t' | Text -> Bool
T.null Text
t' -> Text
t'
| Text -> Char
T.last Text
t' forall a. Eq a => a -> a -> Bool
== Char
'\\' -> Text
t' forall a. Semigroup a => a -> a -> a
<> Text
"#"
| Bool
otherwise -> Text
t'
scanReference :: Scanner
scanReference :: Scanner
scanReference = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. Parser a -> Parser a
lookAhead (Parser Text
pLinkLabel forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Scanner
scanChar Char
':')
scanBlockquoteStart :: Scanner
scanBlockquoteStart :: Scanner
scanBlockquoteStart = Char -> Scanner
scanChar Char
'>' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Char -> Scanner
scanChar Char
' ')
parseAtxHeaderStart :: Parser Int
= do
Char -> Parser Char
char Char
'#'
Text
hashes <- Int -> (Char -> Bool) -> Parser Text
upToCountChars Int
5 (forall a. Eq a => a -> a -> Bool
== Char
'#')
forall a. Parser a -> Scanner
notFollowedBy ((Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
/= Char
' '))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
hashes forall a. Num a => a -> a -> a
+ Int
1
parseSetextHeaderLine :: Parser Int
= do
Char
d <- (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'=')
let lev :: Int
lev = if Char
d forall a. Eq a => a -> a -> Bool
== Char
'=' then Int
1 else Int
2
(Char -> Bool) -> Scanner
skipWhile (forall a. Eq a => a -> a -> Bool
== Char
d)
Scanner
scanBlankline
forall (m :: * -> *) a. Monad m => a -> m a
return Int
lev
scanHRuleLine :: Scanner
scanHRuleLine :: Scanner
scanHRuleLine = do
Char
c <- (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 forall a b. (a -> b) -> a -> b
$ Scanner
scanSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
== Char
c)
(Char -> Bool) -> Scanner
skipWhile (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
c)
Scanner
endOfInput
parseCodeFence :: Parser ContainerType
parseCodeFence :: Parser ContainerType
parseCodeFence = do
Int
col <- Position -> Int
column forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Position
getPosition
Text
cs <- (Char -> Bool) -> Parser Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
==Char
'`') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
==Char
'~')
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
cs forall a. Ord a => a -> a -> Bool
>= Int
3
Scanner
scanSpaces
Text
rawattr <- (Char -> Bool) -> Parser Text
takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'`' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'~')
Scanner
endOfInput
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FencedCode { startColumn :: Int
startColumn = Int
col
, fence :: Text
fence = Text
cs
, info :: Text
info = Text
rawattr }
parseHtmlBlockStart :: Parser ()
parseHtmlBlockStart :: Scanner
parseHtmlBlockStart = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. Parser a -> Parser a
lookAhead
((do (HtmlTagType, Text)
t <- Parser (HtmlTagType, Text)
pHtmlTag
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ HtmlTagType -> Bool
f forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (HtmlTagType, Text)
t
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (HtmlTagType, Text)
t)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"<!--"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"-->"
)
where f :: HtmlTagType -> Bool
f (Opening Text
name) = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags
f (SelfClosing Text
name) = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags
f (Closing Text
name) = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockHtmlTags
blockHtmlTags :: Set.Set Text
blockHtmlTags :: Set Text
blockHtmlTags = forall a. Ord a => [a] -> Set a
Set.fromList
[ Text
"article", Text
"header", Text
"aside", Text
"hgroup", Text
"blockquote", Text
"hr",
Text
"body", Text
"li", Text
"br", Text
"map", Text
"button", Text
"object", Text
"canvas", Text
"ol",
Text
"caption", Text
"output", Text
"col", Text
"p", Text
"colgroup", Text
"pre", Text
"dd",
Text
"progress", Text
"div", Text
"section", Text
"dl", Text
"table", Text
"dt", Text
"tbody",
Text
"embed", Text
"textarea", Text
"fieldset", Text
"tfoot", Text
"figcaption", Text
"th",
Text
"figure", Text
"thead", Text
"footer", Text
"footer", Text
"tr", Text
"form", Text
"ul",
Text
"h1", Text
"h2", Text
"h3", Text
"h4", Text
"h5", Text
"h6", Text
"video"]
parseListMarker :: Parser ContainerType
parseListMarker :: Parser ContainerType
parseListMarker = do
Int
col <- Position -> Int
column forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Position
getPosition
ListType
ty <- Parser ListType
parseBullet forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ListType
parseListNumber
Int
padding' <- (Int
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner
scanBlankline)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
==Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser a -> Parser a
lookAhead (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 (Char -> Parser Char
char Char
' '))))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Int
T.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile (forall a. Eq a => a -> a -> Bool
==Char
' '))
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
padding' forall a. Ord a => a -> a -> Bool
> Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListItem { listType :: ListType
listType = ListType
ty
, markerColumn :: Int
markerColumn = Int
col
, padding :: Int
padding = Int
padding' forall a. Num a => a -> a -> a
+ ListType -> Int
listMarkerWidth ListType
ty
}
listMarkerWidth :: ListType -> Int
listMarkerWidth :: ListType -> Int
listMarkerWidth (Bullet Char
_) = Int
1
listMarkerWidth (Numbered NumWrapper
_ Int
n) | Int
n forall a. Ord a => a -> a -> Bool
< Int
10 = Int
2
| Int
n forall a. Ord a => a -> a -> Bool
< Int
100 = Int
3
| Int
n forall a. Ord a => a -> a -> Bool
< Int
1000 = Int
4
| Bool
otherwise = Int
5
parseBullet :: Parser ListType
parseBullet :: Parser ListType
parseBullet = do
Char
c <- (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
c forall a. Eq a => a -> a -> Bool
== Char
'+')
forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Scanner
nfb forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 forall a b. (a -> b) -> a -> b
$ Scanner
scanSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
== Char
c)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Char -> Bool) -> Scanner
skipWhile (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scanner
endOfInput
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> ListType
Bullet Char
c
parseListNumber :: Parser ListType
parseListNumber :: Parser ListType
parseListNumber = do
Int
num <- (forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isDigit
NumWrapper
wrap <- NumWrapper
PeriodFollowing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
== Char
'.')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NumWrapper
ParenFollowing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool) -> Scanner
skip (forall a. Eq a => a -> a -> Bool
== Char
')')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NumWrapper -> Int -> ListType
Numbered NumWrapper
wrap Int
num