    {-# 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 = SyntaxSpec m il bl
    forall a. Monoid a => a
    mempty
      { syntaxBlockSpecs = [taskListItemBlockSpec]
      }

    data ListData = ListData
         { ListData -> ListType
    listType    :: !ListType
         , ListData -> ListSpacing
    listSpacing :: !ListSpacing
         } deriving (Int -> ListData -> ShowS
    [ListData] -> ShowS
    ListData -> String
    (Int -> ListData -> ShowS)
    -> (ListData -> String) -> ([ListData] -> ShowS) -> Show ListData
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ListData -> ShowS
    showsPrec :: Int -> ListData -> ShowS
    $cshow :: ListData -> String
    show :: ListData -> String
    $cshowList :: [ListData] -> ShowS
    showList :: [ListData] -> ShowS
    Show, ListData -> ListData -> Bool
    (ListData -> ListData -> Bool)
    -> (ListData -> ListData -> Bool) -> Eq ListData
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListData -> ListData -> Bool
    == :: ListData -> ListData -> Bool
    $c/= :: ListData -> ListData -> Bool
    /= :: 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
    (Int -> ListItemData -> ShowS)
    -> (ListItemData -> String)
    -> ([ListItemData] -> ShowS)
    -> Show ListItemData
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ListItemData -> ShowS
    showsPrec :: Int -> ListItemData -> ShowS
    $cshow :: ListItemData -> String
    show :: ListItemData -> String
    $cshowList :: [ListItemData] -> ShowS
    showList :: [ListItemData] -> ShowS
    Show, ListItemData -> ListItemData -> Bool
    (ListItemData -> ListItemData -> Bool)
    -> (ListItemData -> ListItemData -> Bool) -> Eq ListItemData
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListItemData -> ListItemData -> Bool
    == :: ListItemData -> ListItemData -> Bool
    $c/= :: ListItemData -> ListItemData -> Bool
    /= :: 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          = BlockParser m il bl BlockStartResult
    forall a. ParsecT [Tok] (BPState m il bl) m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
         , blockCanContain :: BlockSpec m il bl -> Bool
    blockCanContain     = \BlockSpec m il bl
    sp -> BlockSpec m il bl -> Text
    forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
    blockType BlockSpec m il bl
    sp Text -> Text -> Bool
    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) (SourcePos -> (SourcePos, BlockNode m il bl))
    -> ParsecT [Tok] (BPState m il bl) m SourcePos
    -> BlockParser m il bl (SourcePos, BlockNode m il bl)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (BPState m il bl) m SourcePos
    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 = Dynamic -> ListData -> ListData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
    blockData (BlockNode m il bl -> BlockData m il bl
    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 (ListItemData -> Bool) -> ListItemData -> Bool
    forall a b. (a -> b) -> a -> b
    $
                          Dynamic -> ListItemData -> ListItemData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
    blockData (Tree (BlockData m il bl) -> BlockData m il bl
    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 = (BlockNode m il bl -> Bool) -> [BlockNode m il bl] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockNode m il bl -> Bool
    forall {m :: * -> *} {il} {bl}. Tree (BlockData m il bl) -> Bool
    getCheckedStatus ([BlockNode m il bl] -> [Bool]) -> [BlockNode m il bl] -> [Bool]
    forall a b. (a -> b) -> a -> b
    $ BlockNode m il bl -> [BlockNode m il bl]
    forall a. Tree a -> [Tree a]
    subForest BlockNode m il bl
    node
              ListType -> ListSpacing -> [(Bool, bl)] -> bl
    forall il bl.
    HasTaskList il bl =>
    ListType -> ListSpacing -> [(Bool, bl)] -> bl
    taskList ListType
    lt ListSpacing
    ls ([(Bool, bl)] -> bl) -> ([bl] -> [(Bool, bl)]) -> [bl] -> bl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Bool] -> [bl] -> [(Bool, bl)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Bool]
    checkedStatus ([bl] -> bl)
    -> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
    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
    _ = Dynamic -> ListData -> ListData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    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)]
    _) =
                    Dynamic -> ListItemData -> ListItemData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    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 = (BlockNode m il bl -> ListItemData)
    -> [BlockNode m il bl] -> [ListItemData]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockNode m il bl -> ListItemData
    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 | (ListItemData -> Bool) -> [ListItemData] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ListItemData -> Bool
    listItemBlanksInside (ListItemData
    cListItemData -> [ListItemData] -> [ListItemData]
    forall a. a -> [a] -> [a]
    :[ListItemData]
    cs) Bool -> Bool -> Bool
    ||
                                     (Bool -> Bool
    not ([ListItemData] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ListItemData]
    cs) Bool -> Bool -> Bool
    &&
                                      (ListItemData -> Bool) -> [ListItemData] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ListItemData -> Bool
    listItemBlanksAtEnd [ListItemData]
    cs)
                                   -> ListSpacing
    LooseList
                              [ListItemData]
    _    -> ListSpacing
    TightList
              blockBlanks' <- case [ListItemData]
    childrenData of
                                 ListItemData
    c:[ListItemData]
    _ | ListItemData -> Bool
    listItemBlanksAtEnd ListItemData
    c -> do
                                     curline <- SourcePos -> Int
    sourceLine (SourcePos -> Int)
    -> ParsecT [Tok] (BPState m il bl) m SourcePos
    -> ParsecT [Tok] (BPState m il bl) m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                                     return $! curline - 1 : blockBlanks cdata
                                 [ListItemData]
    _ -> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
    forall a. a -> ParsecT [Tok] (BPState m il bl) m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Int] -> ParsecT [Tok] (BPState m il bl) m [Int])
    -> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
    forall a b. (a -> b) -> a -> b
    $! BlockData m il bl -> [Int]
    forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
    blockBlanks BlockData m il bl
    cdata
              let ldata' = ListData -> Dynamic
    forall a. Typeable a => a -> Dynamic
    toDyn (ListType -> ListSpacing -> ListData
    ListData ListType
    lt ListSpacing
    ls)
              -- need to transform paragraphs on tight lists
              let totight (Node BlockData m il bl
    nd [Tree (BlockData m il bl)]
    cs)
                    | BlockSpec m il bl -> Text
    forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
    blockType (BlockData m il bl -> BlockSpec m il bl
    forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
    blockSpec BlockData m il bl
    nd) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "Paragraph"
                                = BlockData m il bl
    -> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
    forall a. a -> [Tree a] -> Tree a
    Node BlockData m il bl
    nd{ blockSpec = plainSpec } [Tree (BlockData m il bl)]
    cs
                    | Bool
    otherwise = BlockData m il bl
    -> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
    forall a. a -> [Tree a] -> Tree a
    Node BlockData m il bl
    nd [Tree (BlockData m il bl)]
    cs
              let childrenToTight (Node BlockData m il bl
    nd [Tree (BlockData m il bl)]
    cs) = BlockData m il bl
    -> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
    forall a. a -> [Tree a] -> Tree a
    Node BlockData m il bl
    nd ((Tree (BlockData m il bl) -> Tree (BlockData m il bl))
    -> [Tree (BlockData m il bl)] -> [Tree (BlockData m il bl)]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree (BlockData m il bl) -> Tree (BlockData m il bl)
    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' =
                     if ListSpacing
    ls ListSpacing -> ListSpacing -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListSpacing
    TightList
                        then (BlockNode m il bl -> BlockNode m il bl)
    -> [BlockNode m il bl] -> [BlockNode m il bl]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockNode m il bl -> BlockNode m il bl
    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
              defaultFinalizer (Node cdata{ blockData = ldata'
                                          , blockBlanks = blockBlanks' } children')
                               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
                 (pos, lidata) <- BlockParser m il bl (SourcePos, ListItemData)
    forall (m :: * -> *) il bl.
    Monad m =>
    BlockParser m il bl (SourcePos, ListItemData)
    itemStart
                 let linode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
    forall a. a -> [Tree a] -> Tree a
    Node (BlockSpec m il bl -> BlockData m il bl
    forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
    defBlockData BlockSpec m il bl
    forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, HasTaskList il bl) =>
    BlockSpec m il bl
    taskListItemBlockSpec){
                                 blockData = toDyn lidata,
                                 blockStartPos = [pos] } []
                 let listdata = ListData{
                        listType :: ListType
    listType = ListItemData -> ListType
    listItemType ListItemData
    lidata
                      , listSpacing :: ListSpacing
    listSpacing = ListSpacing
    TightList }
                      -- spacing gets set in finalize
                 let listnode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
    forall a. a -> [Tree a] -> Tree a
    Node (BlockSpec m il bl -> BlockData m il bl
    forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
    defBlockData BlockSpec m il bl
    forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, HasTaskList il bl) =>
    BlockSpec m il bl
    taskListBlockSpec){
                                  blockData = toDyn listdata,
                                  blockStartPos = [pos] } []
                 -- list can only interrupt paragraph if bullet
                 -- list or ordered list w/ startnum == 1,
                 -- and not followed by blank
                 (cur:_) <- nodeStack <$> getState
                 when (blockParagraph (bspec cur)) $ do
                   guard $ case listType listdata of
                                BulletList Char
    _            -> Bool
    True
                                OrderedList Int
    1 EnumeratorType
    Decimal DelimiterType
    _ -> Bool
    True
                                ListType
    _                       -> Bool
    False
                   notFollowedBy blankLine
                 let curdata = Dynamic -> ListData -> ListData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
    blockData (BlockNode m il bl -> BlockData m il bl
    forall a. Tree a -> a
    rootLabel BlockNode m il bl
    cur))
                                    (ListType -> ListSpacing -> ListData
    ListData (Char -> ListType
    BulletList Char
    '*') ListSpacing
    TightList)
                 let matchesList (BulletList Char
    c) (BulletList Char
    d)       = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    d
                     matchesList (OrderedList Int
    _ EnumeratorType
    e1 DelimiterType
    d1)
                                 (OrderedList Int
    _ EnumeratorType
    e2 DelimiterType
    d2) = EnumeratorType
    e1 EnumeratorType -> EnumeratorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EnumeratorType
    e2 Bool -> Bool -> Bool
    && DelimiterType
    d1 DelimiterType -> DelimiterType -> Bool
    forall a. Eq a => a -> a -> Bool
    == DelimiterType
    d2
                     matchesList ListType
    _ ListType
    _                                 = Bool
    False
                 case blockType (bspec cur) of
                      Text
    "TaskList" | ListData -> ListType
    listType ListData
    curdata ListType -> ListType -> Bool
    `matchesList`
                                   ListItemData -> ListType
    listItemType ListItemData
    lidata
                        -> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) bl il.
    Monad m =>
    BlockNode m bl il -> BlockParser m bl il ()
    addNodeToStack BlockNode m il bl
    linode
                      Text
    _ -> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) bl il.
    Monad m =>
    BlockNode m bl il -> BlockParser m bl il ()
    addNodeToStack BlockNode m il bl
    listnode ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b.
    ParsecT [Tok] (BPState m il bl) m a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
    forall (m :: * -> *) bl il.
    Monad m =>
    BlockNode m bl il -> BlockParser m bl il ()
    addNodeToStack BlockNode m il bl
    linode
                 blankAfterMarker <- optionMaybe blankLine
                 pos' <- getPosition
                 case blankAfterMarker of
                      Just ()
    _ -> () -> ParsecT [Tok] (BPState m il bl) m ()
    forall a. a -> ParsecT [Tok] (BPState m il bl) m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      Maybe ()
    Nothing -> do
                        toks <- ParsecT [Tok] (BPState m il bl) m Tok
    -> ParsecT [Tok] (BPState m il bl) m [Tok]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ((Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Tok -> Bool) -> ParsecT [Tok] s m Tok
    satisfyTok (Bool -> Bool
    not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TokType -> Tok -> Bool
    hasType TokType
    LineEnd))
                        addNodeToStack $
                            Node (defBlockData paraSpec){
                                  blockStartPos = [pos']
                                , blockLines = [toks] }
                            []
                 return BlockStartMatch
         , blockCanContain :: BlockSpec m il bl -> Bool
    blockCanContain     = Bool -> BlockSpec m il bl -> Bool
    forall a b. a -> b -> a
    const Bool
    True
         , 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       = \node :: BlockNode m il bl
    node@(Node BlockData m il bl
    ndata [BlockNode m il bl]
    children) -> do
                 let lidata :: ListItemData
    lidata = Dynamic -> ListItemData -> ListItemData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    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:
                 Bool -> ParsecT [Tok] (BPState m il bl) m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
    -> Bool -> ParsecT [Tok] (BPState m il bl) m ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (BlockData m il bl -> [Int]
    forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
    blockBlanks BlockData m il bl
    ndata) Bool -> Bool -> Bool
    ||
                         Bool -> Bool
    not ([BlockNode m il bl] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [BlockNode m il bl]
    children)
                 pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
                 gobbleSpaces (listItemIndent lidata) <|> 0 <$ lookAhead blankLine
                 return $! (pos, node)
         , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
    blockConstructor    = ([bl] -> bl)
    -> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
    forall a b.
    (a -> b)
    -> ParsecT [Tok] (BPState m il bl) m a
    -> ParsecT [Tok] (BPState m il bl) m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [bl] -> bl
    forall a. Monoid a => [a] -> a
    mconcat (ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl)
    -> (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl])
    -> BlockNode m il bl
    -> BlockParser m il bl bl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
    forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl) =>
    BlockNode m il bl -> BlockParser m il bl [bl]
    renderChildren
         , 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 lidata :: ListItemData
    lidata = Dynamic -> ListItemData -> ListItemData
    forall a. Typeable a => Dynamic -> a -> a
    fromDyn (BlockData m il bl -> Dynamic
    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 ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    sort ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $
                             [[Int]] -> [Int]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ BlockData m il bl -> [Int]
    forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
    blockBlanks BlockData m il bl
    cdata [Int] -> [[Int]] -> [[Int]]
    forall a. a -> [a] -> [a]
    :
                                      (BlockNode m il bl -> [Int]) -> [BlockNode m il bl] -> [[Int]]
    forall a b. (a -> b) -> [a] -> [b]
    map (BlockData m il bl -> [Int]
    forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
    blockBlanks (BlockData m il bl -> [Int])
    -> (BlockNode m il bl -> BlockData m il bl)
    -> BlockNode m il bl
    -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockNode m il bl -> BlockData m il bl
    forall a. Tree a -> a
    rootLabel)
                                      ((BlockNode m il bl -> Bool)
    -> [BlockNode m il bl] -> [BlockNode m il bl]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "List") (Text -> Bool)
    -> (BlockNode m il bl -> Text) -> BlockNode m il bl -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockSpec m il bl -> Text
    forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
    blockType (BlockSpec m il bl -> Text)
    -> (BlockNode m il bl -> BlockSpec m il bl)
    -> BlockNode m il bl
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                       BlockData m il bl -> BlockSpec m il bl
    forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
    blockSpec (BlockData m il bl -> BlockSpec m il bl)
    -> (BlockNode m il bl -> BlockData m il bl)
    -> BlockNode m il bl
    -> BlockSpec m il bl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlockNode m il bl -> BlockData m il bl
    forall a. Tree a -> a
    rootLabel) [BlockNode m il bl]
    children)
              curline <- SourcePos -> Int
    sourceLine (SourcePos -> Int)
    -> ParsecT [Tok] (BPState m il bl) m SourcePos
    -> ParsecT [Tok] (BPState m il bl) m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
              let blanksAtEnd = case [Int]
    blanks of
                                       (Int
    l:[Int]
    _) -> Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    curline Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                                       [Int]
    _     -> Bool
    False
              let blanksInside = case [Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    blanks of
                                    Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1     -> Bool
    True
                                      | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1    -> Bool -> Bool
    not Bool
    blanksAtEnd
                                      | Bool
    otherwise -> Bool
    False
              let lidata' = ListItemData -> Dynamic
    forall a. Typeable a => a -> Dynamic
    toDyn (ListItemData -> Dynamic) -> ListItemData -> Dynamic
    forall a b. (a -> b) -> a -> b
    $ ListItemData
    lidata{ listItemBlanksInside = blanksInside
                                          , listItemBlanksAtEnd  = blanksAtEnd }
              defaultFinalizer (Node cdata{ blockData = lidata' } children)
                               parent
         }

    removeConsecutive :: [Int] -> [Int]
    removeConsecutive :: [Int] -> [Int]
    removeConsecutive (Int
    x:Int
    y:[Int]
    zs)
      | Int
    x Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 = [Int] -> [Int]
    removeConsecutive (Int
    yInt -> [Int] -> [Int]
    forall 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
      beforecol <- SourcePos -> Int
    sourceColumn (SourcePos -> Int)
    -> ParsecT [Tok] (BPState m il bl) m SourcePos
    -> ParsecT [Tok] (BPState m il bl) m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT [Tok] (BPState m il bl) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
      gobbleUpToSpaces 3
      pos <- getPosition
      ty <- bulletListMarker
      aftercol <- sourceColumn <$> getPosition
      lookAhead whitespace
      numspaces <- try (gobbleUpToSpaces 4 <* notFollowedBy whitespace)
               <|> gobbleSpaces 1
      checked <- parseCheckbox
      lookAhead whitespace
      return $! (pos, ListItemData{
                listItemType = ty
              , listItemChecked = checked
              , listItemIndent = (aftercol - beforecol) + numspaces
              , listItemBlanksInside = False
              , listItemBlanksAtEnd = False
              })

    parseCheckbox :: Monad m => BlockParser m il bl Bool
    parseCheckbox :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl Bool
    parseCheckbox = do
      Int -> ParsecT [Tok] (BPState m il bl) m Int
    forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
    gobbleUpToSpaces Int
    3
      Char -> ParsecT [Tok] (BPState m il bl) m Tok
    forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
    symbol Char
    '['
      checked <- (Bool
    False Bool
    -> ParsecT [Tok] (BPState m il bl) m Tok
    -> ParsecT [Tok] (BPState m il bl) m Bool
    forall a b.
    a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Tok -> Bool) -> ParsecT [Tok] s m Tok
    satisfyTok (TokType -> Tok -> Bool
    hasType TokType
    Spaces))
             ParsecT [Tok] (BPState m il bl) m Bool
    -> ParsecT [Tok] (BPState m il bl) m Bool
    -> ParsecT [Tok] (BPState m il bl) m Bool
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> (Bool
    True  Bool
    -> ParsecT [Tok] (BPState m il bl) m Tok
    -> ParsecT [Tok] (BPState m il bl) m Bool
    forall a b.
    a
    -> ParsecT [Tok] (BPState m il bl) m b
    -> ParsecT [Tok] (BPState m il bl) m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
    forall (m :: * -> *) s.
    Monad m =>
    (Tok -> Bool) -> ParsecT [Tok] s m Tok
    satisfyTok ((Text -> Bool) -> Tok -> Bool
    textIs (\Text
    t -> Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "x" Bool -> Bool -> Bool
    || Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "X")))
      symbol ']'
      return 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 =
        Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "class",Text
    "task-list")
        (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $ ListType -> ListSpacing -> [Html a] -> Html a
    forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
    list ListType
    lt ListSpacing
    spacing
        ([Html a] -> Html a) -> [Html a] -> Html a
    forall a b. (a -> b) -> a -> b
    $ ((Bool, Html a) -> Html a) -> [(Bool, Html a)] -> [Html a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, Html a) -> Html a
    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) =
      (Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "type", Text
    "checkbox") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
       Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "disabled", Text
    "") (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
       (if Bool
    checked then Attribute -> Html a -> Html a
    forall a. Attribute -> Html a -> Html a
    addAttribute (Text
    "checked",Text
    "") else Html a -> Html a
    forall a. a -> a
    id) (Html a -> Html a) -> Html a -> Html a
    forall a b. (a -> b) -> a -> b
    $
       Text -> Maybe (Html a) -> Html a
    forall a. Text -> Maybe (Html a) -> Html a
    htmlInline Text
    "input" Maybe (Html a)
    forall a. Maybe a
    Nothing) Html a -> Html a -> Html a
    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) = [(Bool, WithSourceMap bl)] -> ([Bool], [WithSourceMap bl])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Bool, WithSourceMap bl)]
    items
             ListType -> ListSpacing -> [(Bool, bl)] -> bl
    forall il bl.
    HasTaskList il bl =>
    ListType -> ListSpacing -> [(Bool, bl)] -> bl
    taskList ListType
    lt ListSpacing
    spacing ([(Bool, bl)] -> bl) -> ([bl] -> [(Bool, bl)]) -> [bl] -> bl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Bool] -> [bl] -> [(Bool, bl)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Bool]
    checks ([bl] -> bl) -> WithSourceMap [bl] -> WithSourceMap bl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [WithSourceMap bl] -> WithSourceMap [bl]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [WithSourceMap bl]
    xs
          ) WithSourceMap bl -> WithSourceMap () -> WithSourceMap bl
    forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Text -> WithSourceMap ()
    addName Text
    "taskList"