{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Commonmark.Extensions.TaskList
  ( taskListSpec
  , HasTaskList (..)
  )
where
import Commonmark.Tokens
import Commonmark.Types
import Commonmark.Syntax
import Commonmark.Blocks
import Commonmark.SourceMap
import Commonmark.TokParsers
import Commonmark.Html
import Control.Monad (mzero)
import Control.Monad (when, guard)
import Data.List (sort)
import Data.Dynamic
import Data.Tree
import Text.Parsec


taskListSpec :: (Monad m, IsBlock il bl, IsInline il, HasTaskList il bl)
                   => SyntaxSpec m il bl
taskListSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasTaskList il bl) =>
SyntaxSpec m il bl
taskListSpec = forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasTaskList il bl) =>
BlockSpec m il bl
taskListItemBlockSpec]
  }

data ListData = ListData
     { ListData -> ListType
listType    :: !ListType
     , ListData -> ListSpacing
listSpacing :: !ListSpacing
     } deriving (Int -> ListData -> ShowS
[ListData] -> ShowS
ListData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListData] -> ShowS
$cshowList :: [ListData] -> ShowS
show :: ListData -> String
$cshow :: ListData -> String
showsPrec :: Int -> ListData -> ShowS
$cshowsPrec :: Int -> ListData -> ShowS
Show, ListData -> ListData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListData -> ListData -> Bool
$c/= :: ListData -> ListData -> Bool
== :: ListData -> ListData -> Bool
$c== :: ListData -> ListData -> Bool
Eq)

data ListItemData = ListItemData
     { ListItemData -> ListType
listItemType         :: !ListType
     , ListItemData -> Bool
listItemChecked      :: !Bool
     , ListItemData -> Int
listItemIndent       :: !Int
     , ListItemData -> Bool
listItemBlanksInside :: !Bool
     , ListItemData -> Bool
listItemBlanksAtEnd  :: !Bool
     } deriving (Int -> ListItemData -> ShowS
[ListItemData] -> ShowS
ListItemData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItemData] -> ShowS
$cshowList :: [ListItemData] -> ShowS
show :: ListItemData -> String
$cshow :: ListItemData -> String
showsPrec :: Int -> ListItemData -> ShowS
$cshowsPrec :: Int -> ListItemData -> ShowS
Show, ListItemData -> ListItemData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItemData -> ListItemData -> Bool
$c/= :: ListItemData -> ListItemData -> Bool
== :: ListItemData -> ListItemData -> Bool
$c== :: ListItemData -> ListItemData -> Bool
Eq)

taskListBlockSpec :: (Monad m, IsBlock il bl,
                      HasTaskList il bl) => BlockSpec m il bl
taskListBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasTaskList il bl) =>
BlockSpec m il bl
taskListBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"TaskList"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp forall a. Eq a => a -> a -> Bool
== Text
"TaskListItem"
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> (,BlockNode m il bl
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
          let ListData ListType
lt ListSpacing
ls = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
          let getCheckedStatus :: Tree (BlockData m il bl) -> Bool
getCheckedStatus Tree (BlockData m il bl)
n =
               ListItemData -> Bool
listItemChecked forall a b. (a -> b) -> a -> b
$
                      forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel Tree (BlockData m il bl)
n))
                         (ListType -> Bool -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Bool
False Int
0 Bool
False Bool
False)
          let checkedStatus :: [Bool]
checkedStatus = forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}. Tree (BlockData m il bl) -> Bool
getCheckedStatus forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
node
          forall il bl.
HasTaskList il bl =>
ListType -> ListSpacing -> [(Bool, bl)] -> bl
taskList ListType
lt ListSpacing
ls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
checkedStatus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
          let ListData ListType
lt ListSpacing
_ = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
          let getListItemData :: Tree (BlockData m il bl) -> ListItemData
getListItemData (Node BlockData m il bl
d [Tree (BlockData m il bl)]
_) =
                forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
d)
                  (ListType -> Bool -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Bool
False Int
0 Bool
False Bool
False)
          let childrenData :: [ListItemData]
childrenData = forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
Tree (BlockData m il bl) -> ListItemData
getListItemData [BlockNode m il bl]
children
          let ls :: ListSpacing
ls = case [ListItemData]
childrenData of
                          ListItemData
c:[ListItemData]
cs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksInside (ListItemData
cforall a. a -> [a] -> [a]
:[ListItemData]
cs) Bool -> Bool -> Bool
||
                                 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ListItemData]
cs) Bool -> Bool -> Bool
&&
                                  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksAtEnd [ListItemData]
cs)
                               -> ListSpacing
LooseList
                          [ListItemData]
_    -> ListSpacing
TightList
          [Int]
blockBlanks' <- case [ListItemData]
childrenData of
                             ListItemData
c:[ListItemData]
_ | ListItemData -> Bool
listItemBlanksAtEnd ListItemData
c -> do
                                 Int
curline <- SourcePos -> Int
sourceLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
curline forall a. Num a => a -> a -> a
- Int
1 forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
                             [ListItemData]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
          let ldata' :: Dynamic
ldata' = forall a. Typeable a => a -> Dynamic
toDyn (ListType -> ListSpacing -> ListData
ListData ListType
lt ListSpacing
ls)
          -- need to transform paragraphs on tight lists
          let totight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs)
                | forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
nd) forall a. Eq a => a -> a -> Bool
== Text
"Paragraph"
                            = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd{ blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec } [Tree (BlockData m il bl)]
cs
                | Bool
otherwise = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs
          let childrenToTight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs) = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd (forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight [Tree (BlockData m il bl)]
cs)
          let children' :: [BlockNode m il bl]
children' =
                 if ListSpacing
ls forall a. Eq a => a -> a -> Bool
== ListSpacing
TightList
                    then forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight [BlockNode m il bl]
children
                    else [BlockNode m il bl]
children
          forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
ldata'
                                      , blockBlanks :: [Int]
blockBlanks = [Int]
blockBlanks' } [BlockNode m il bl]
children')
                           BlockNode m il bl
parent
     }

taskListItemBlockSpec :: (Monad m, IsBlock il bl, HasTaskList il bl)
                      => BlockSpec m il bl
taskListItemBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasTaskList il bl) =>
BlockSpec m il bl
taskListItemBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"TaskListItem"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             (SourcePos
pos, ListItemData
lidata) <- forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl (SourcePos, ListItemData)
itemStart
             let linode :: Tree (BlockData m il bl)
linode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasTaskList il bl) =>
BlockSpec m il bl
taskListItemBlockSpec){
                             blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListItemData
lidata,
                             blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             let listdata :: ListData
listdata = ListData{
                    listType :: ListType
listType = ListItemData -> ListType
listItemType ListItemData
lidata
                  , listSpacing :: ListSpacing
listSpacing = ListSpacing
TightList }
                  -- spacing gets set in finalize
             let listnode :: Tree (BlockData m il bl)
listnode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasTaskList il bl) =>
BlockSpec m il bl
taskListBlockSpec){
                              blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListData
listdata,
                              blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             -- list can only interrupt paragraph if bullet
             -- list or ordered list w/ startnum == 1,
             -- and not followed by blank
             (Tree (BlockData m il bl)
cur:[Tree (BlockData m il bl)]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur)) forall a b. (a -> b) -> a -> b
$ do
               forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ case ListData -> ListType
listType ListData
listdata of
                            BulletList Char
_            -> Bool
True
                            OrderedList Int
1 EnumeratorType
Decimal DelimiterType
_ -> Bool
True
                            ListType
_                       -> Bool
False
               forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             let curdata :: ListData
curdata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel Tree (BlockData m il bl)
cur))
                                (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
             let matchesList :: ListType -> ListType -> Bool
matchesList (BulletList Char
c) (BulletList Char
d)       = Char
c forall a. Eq a => a -> a -> Bool
== Char
d
                 matchesList (OrderedList Int
_ EnumeratorType
e1 DelimiterType
d1)
                             (OrderedList Int
_ EnumeratorType
e2 DelimiterType
d2) = EnumeratorType
e1 forall a. Eq a => a -> a -> Bool
== EnumeratorType
e2 Bool -> Bool -> Bool
&& DelimiterType
d1 forall a. Eq a => a -> a -> Bool
== DelimiterType
d2
                 matchesList ListType
_ ListType
_                                 = Bool
False
             case forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur) of
                  Text
"TaskList" | ListData -> ListType
listType ListData
curdata ListType -> ListType -> Bool
`matchesList`
                               ListItemData -> ListType
listItemType ListItemData
lidata
                    -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
                  Text
_ -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
listnode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: Tree (BlockData m il bl)
-> BlockParser m il bl (SourcePos, Tree (BlockData m il bl))
blockContinue       = \node :: Tree (BlockData m il bl)
node@(Node BlockData m il bl
ndata [Tree (BlockData m il bl)]
children) -> do
             let lidata :: ListItemData
lidata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                             (ListType -> Bool -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Bool
False Int
0
                              Bool
False Bool
False)
             -- a marker followed by two blanks is just an empty item:
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
ndata) Bool -> Bool -> Bool
||
                     Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree (BlockData m il bl)]
children)
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces (ListItemData -> Int
listItemIndent ListItemData
lidata) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, Tree (BlockData m il bl)
node)
     , blockConstructor :: Tree (BlockData m il bl) -> BlockParser m il bl bl
blockConstructor    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren
     , blockFinalize :: Tree (BlockData m il bl)
-> Tree (BlockData m il bl)
-> BlockParser m il bl (Tree (BlockData m il bl))
blockFinalize       = \(Node BlockData m il bl
cdata [Tree (BlockData m il bl)]
children) Tree (BlockData m il bl)
parent -> do
          let lidata :: ListItemData
lidata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> Bool -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Bool
False
                                   Int
0 Bool
False Bool
False)
          let blanks :: [Int]
blanks = [Int] -> [Int]
removeConsecutive forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$
                         forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata forall a. a -> [a] -> [a]
:
                                  forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel)
                                  (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Text
"List") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel) [Tree (BlockData m il bl)]
children)
          Int
curline <- SourcePos -> Int
sourceLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
          let blanksAtEnd :: Bool
blanksAtEnd = case [Int]
blanks of
                                   (Int
l:[Int]
_) -> Int
l forall a. Ord a => a -> a -> Bool
>= Int
curline forall a. Num a => a -> a -> a
- Int
1
                                   [Int]
_     -> Bool
False
          let blanksInside :: Bool
blanksInside = case forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
blanks of
                                Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
1     -> Bool
True
                                  | Int
n forall a. Eq a => a -> a -> Bool
== Int
1    -> Bool -> Bool
not Bool
blanksAtEnd
                                  | Bool
otherwise -> Bool
False
          let lidata' :: Dynamic
lidata' = forall a. Typeable a => a -> Dynamic
toDyn forall a b. (a -> b) -> a -> b
$ ListItemData
lidata{ listItemBlanksInside :: Bool
listItemBlanksInside = Bool
blanksInside
                                      , listItemBlanksAtEnd :: Bool
listItemBlanksAtEnd  = Bool
blanksAtEnd }
          forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
lidata' } [Tree (BlockData m il bl)]
children)
                           Tree (BlockData m il bl)
parent
     }

removeConsecutive :: [Int] -> [Int]
removeConsecutive :: [Int] -> [Int]
removeConsecutive (Int
x:Int
y:[Int]
zs)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
y forall a. Num a => a -> a -> a
+ Int
1 = [Int] -> [Int]
removeConsecutive (Int
yforall a. a -> [a] -> [a]
:[Int]
zs)
removeConsecutive [Int]
xs = [Int]
xs

itemStart :: Monad m
          => BlockParser m il bl (SourcePos, ListItemData)
itemStart :: forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl (SourcePos, ListItemData)
itemStart = do
  Int
beforecol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
3
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ListType
ty <- forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker
  Int
aftercol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Bool
checked <- forall (m :: * -> *) il bl. Monad m => BlockParser m il bl Bool
parseCheckbox
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Int
numspaces <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
4 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, ListItemData{
            listItemType :: ListType
listItemType = ListType
ty
          , listItemChecked :: Bool
listItemChecked = Bool
checked
          , listItemIndent :: Int
listItemIndent = (Int
aftercol forall a. Num a => a -> a -> a
- Int
beforecol) forall a. Num a => a -> a -> a
+ Int
numspaces
          , listItemBlanksInside :: Bool
listItemBlanksInside = Bool
False
          , listItemBlanksAtEnd :: Bool
listItemBlanksAtEnd = Bool
False
          })

parseCheckbox :: Monad m => BlockParser m il bl Bool
parseCheckbox :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl Bool
parseCheckbox = do
  forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
3
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
  Bool
checked <- (Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces))
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool
True  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok ((Text -> Bool) -> Tok -> Bool
textIs (\Text
t -> Text
t forall a. Eq a => a -> a -> Bool
== Text
"x" Bool -> Bool -> Bool
|| Text
t forall a. Eq a => a -> a -> Bool
== Text
"X")))
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return Bool
checked

class IsBlock il bl => HasTaskList il bl where
  taskList :: ListType -> ListSpacing -> [(Bool, bl)] -> bl

instance Rangeable (Html a) => HasTaskList (Html a) (Html a) where
  taskList :: ListType -> ListSpacing -> [(Bool, Html a)] -> Html a
taskList ListType
lt ListSpacing
spacing [(Bool, Html a)]
items =
    forall a. Attribute -> Html a -> Html a
addAttribute (Text
"class",Text
"task-list")
    forall a b. (a -> b) -> a -> b
$ forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
list ListType
lt ListSpacing
spacing
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Bool, Html a) -> Html a
addCheckbox [(Bool, Html a)]
items

addCheckbox :: (Bool, Html a) -> Html a
addCheckbox :: forall a. (Bool, Html a) -> Html a
addCheckbox (Bool
checked, Html a
x) =
  (forall a. Attribute -> Html a -> Html a
addAttribute (Text
"type", Text
"checkbox") forall a b. (a -> b) -> a -> b
$
   forall a. Attribute -> Html a -> Html a
addAttribute (Text
"disabled", Text
"") forall a b. (a -> b) -> a -> b
$
   (if Bool
checked then forall a. Attribute -> Html a -> Html a
addAttribute (Text
"checked",Text
"") else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
   forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"input" forall a. Maybe a
Nothing) forall a. Semigroup a => a -> a -> a
<> Html a
x

instance (HasTaskList il bl, Semigroup bl, Semigroup il)
        => HasTaskList (WithSourceMap il) (WithSourceMap bl) where
   taskList :: ListType
-> ListSpacing -> [(Bool, WithSourceMap bl)] -> WithSourceMap bl
taskList ListType
lt ListSpacing
spacing [(Bool, WithSourceMap bl)]
items =
     (do let ([Bool]
checks, [WithSourceMap bl]
xs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Bool, WithSourceMap bl)]
items
         forall il bl.
HasTaskList il bl =>
ListType -> ListSpacing -> [(Bool, bl)] -> bl
taskList ListType
lt ListSpacing
spacing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
checks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap bl]
xs
      ) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"taskList"