{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Djot.Blocks
( parseDoc
, toIdentifier
)
where
import Prelude hiding (div)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Data.Char (ord, isAsciiLower, isAsciiUpper, isAscii, isAlphaNum, isDigit)
import Data.Foldable as F
import Djot.Parse
import Djot.AST
import Djot.Inlines (parseInlines, parseTableCells)
import Djot.Options (ParseOptions(..), SourcePosOption(..))
import Djot.Attributes (parseAttributes, AttrParserState, AttrParseResult(..))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.ByteString (ByteString)
import Control.Monad (replicateM_, void, mzero, unless, when, guard, foldM)
import Data.List.NonEmpty (NonEmpty(..))
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Applicative
import Data.Typeable (Typeable)
parseDoc :: ParseOptions -> ByteString -> Either String Doc
parseDoc :: ParseOptions -> ByteString -> Either [Char] Doc
parseDoc ParseOptions
opts ByteString
bs = do
case Parser PState Doc -> PState -> [Chunk] -> Maybe Doc
forall s a. Parser s a -> s -> [Chunk] -> Maybe a
parse Parser PState Doc
pDoc PState{ psParseOptions :: ParseOptions
psParseOptions = ParseOptions
opts
, psContainerStack :: NonEmpty Container
psContainerStack =
[Container] -> NonEmpty Container
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
[Container
emptyContainer{ containerSpec = docSpec }]
, psReferenceMap :: ReferenceMap
psReferenceMap = ReferenceMap
forall a. Monoid a => a
mempty
, psAutoReferenceMap :: ReferenceMap
psAutoReferenceMap = ReferenceMap
forall a. Monoid a => a
mempty
, psNoteMap :: NoteMap
psNoteMap = NoteMap
forall a. Monoid a => a
mempty
, psAttributes :: Attr
psAttributes = Attr
forall a. Monoid a => a
mempty
, psAttrParserState :: Maybe AttrParserState
psAttrParserState = Maybe AttrParserState
forall a. Maybe a
Nothing
, psIds :: Set ByteString
psIds = Set ByteString
forall a. Monoid a => a
mempty
, psAutoIds :: Set ByteString
psAutoIds = Set ByteString
forall a. Monoid a => a
mempty
, psLastColumnPrevLine :: Int
psLastColumnPrevLine = Int
0
, psLastLine :: Int
psLastLine = Int
1
} [Chunk{ chunkLine :: Int
chunkLine = Int
1, chunkColumn :: Int
chunkColumn = Int
1, chunkBytes :: ByteString
chunkBytes = ByteString
bs }] of
Just Doc
doc -> Doc -> Either [Char] Doc
forall a b. b -> Either a b
Right Doc
doc
Maybe Doc
Nothing -> [Char] -> Either [Char] Doc
forall a b. a -> Either a b
Left [Char]
"Parse failure."
data BlockType =
Normal | ListItem | CaptionBlock | Document
deriving (Int -> BlockType -> [Char] -> [Char]
[BlockType] -> [Char] -> [Char]
BlockType -> [Char]
(Int -> BlockType -> [Char] -> [Char])
-> (BlockType -> [Char])
-> ([BlockType] -> [Char] -> [Char])
-> Show BlockType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> BlockType -> [Char] -> [Char]
showsPrec :: Int -> BlockType -> [Char] -> [Char]
$cshow :: BlockType -> [Char]
show :: BlockType -> [Char]
$cshowList :: [BlockType] -> [Char] -> [Char]
showList :: [BlockType] -> [Char] -> [Char]
Show, BlockType -> BlockType -> Bool
(BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool) -> Eq BlockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockType -> BlockType -> Bool
== :: BlockType -> BlockType -> Bool
$c/= :: BlockType -> BlockType -> Bool
/= :: BlockType -> BlockType -> Bool
Eq)
data BlockSpec =
BlockSpec
{
BlockSpec -> [Char]
blockName :: String
,
BlockSpec -> BlockType
blockType :: BlockType
, BlockSpec -> P ()
blockStart :: P ()
, BlockSpec -> Container -> P Bool
blockContinue :: Container -> P Bool
, BlockSpec -> Maybe BlockType
blockContainsBlock :: Maybe BlockType
, BlockSpec -> Bool
blockContainsLines :: Bool
, BlockSpec -> Container -> P Container
blockClose :: Container -> P Container
, BlockSpec -> Container -> Blocks
blockFinalize :: Container -> Blocks
}
docSpec :: BlockSpec
docSpec :: BlockSpec
docSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Doc"
, blockType :: BlockType
blockType = BlockType
Document
, blockStart :: P ()
blockStart = P ()
forall a. Parser PState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = Container -> Blocks
finalizeChildren
}
listItemSpec :: BlockSpec
listItemSpec :: BlockSpec
listItemSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"ListItem"
, blockType :: BlockType
blockType = BlockType
ListItem
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
ltypes <- pListStart
skipMany spaceOrTab
tip :| _ <- psContainerStack <$> getState
case blockContainsBlock (containerSpec tip) of
Just BlockType
ListItem -> () -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe BlockType
_ -> BlockSpec -> Int -> ContainerData -> P ()
addContainer BlockSpec
listSpec Int
ind ContainerData
NoData
addContainer listItemSpec ind (ListItemData ind ltypes False)
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> do
Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P () -> P ()
forall s a. Parser s a -> Parser s ()
fails
(do P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
curind <- Parser PState Int
forall st. Parser st Int
sourceColumn
let liIndent = case Container -> ContainerData
containerData Container
container of
ListItemData Int
i [ListType]
_ Bool
_ -> Int
i
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing ListItemData"
tip :| _ <- psContainerStack <$> getState
guard (curind <= liIndent)
case blockName (containerSpec tip) of
[Char]
"Para" -> P [ListType] -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void P [ListType]
pListStart
[Char]
_ -> () -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P ()
forall s. Parser s ()
followedByBlankLine
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = Container -> Blocks
finalizeChildren
}
pListStart :: P [ListType]
pListStart :: P [ListType]
pListStart = P [ListType]
pBulletListStart P [ListType] -> P [ListType] -> P [ListType]
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P [ListType]
pDefinitionListStart P [ListType] -> P [ListType] -> P [ListType]
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P [ListType]
pOrderedListStart
pBulletListStart :: P [ListType]
pBulletListStart :: P [ListType]
pBulletListStart = do
bulletchar <- (Char -> Bool) -> Parser PState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
followedByWhitespace
(do skipMany spaceOrTab
asciiChar '['
status <- (Complete <$ byteString "x]")
<|> (Complete <$ byteString "X]")
<|> (Incomplete <$ byteString " ]")
followedByWhitespace
pure [Task status])
<|> pure [Bullet bulletchar]
pDefinitionListStart :: P [ListType]
pDefinitionListStart :: P [ListType]
pDefinitionListStart = do
Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
':'
P ()
forall s. Parser s ()
followedByWhitespace
[ListType] -> P [ListType]
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ListType
Definition]
groupLists :: Seq Container -> Seq ([ListType], Seq Container)
groupLists :: Seq Container -> Seq ([ListType], Seq Container)
groupLists = ([ListType], Seq ([ListType], Seq Container))
-> Seq ([ListType], Seq Container)
forall a b. (a, b) -> b
snd (([ListType], Seq ([ListType], Seq Container))
-> Seq ([ListType], Seq Container))
-> (Seq Container -> ([ListType], Seq ([ListType], Seq Container)))
-> Seq Container
-> Seq ([ListType], Seq Container)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([ListType], Seq ([ListType], Seq Container))
-> Container -> ([ListType], Seq ([ListType], Seq Container)))
-> ([ListType], Seq ([ListType], Seq Container))
-> Seq Container
-> ([ListType], Seq ([ListType], Seq Container))
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([ListType], Seq ([ListType], Seq Container))
-> Container -> ([ListType], Seq ([ListType], Seq Container))
go ([], Seq ([ListType], Seq Container)
forall a. Monoid a => a
mempty)
where
go :: ([ListType], Seq ([ListType], Seq Container))
-> Container
-> ([ListType], Seq ([ListType], Seq Container))
go :: ([ListType], Seq ([ListType], Seq Container))
-> Container -> ([ListType], Seq ([ListType], Seq Container))
go ([ListType]
curtypes, Seq ([ListType], Seq Container)
lists) Container
cont =
case Seq ([ListType], Seq Container)
-> ViewR ([ListType], Seq Container)
forall a. Seq a -> ViewR a
Seq.viewr Seq ([ListType], Seq Container)
lists of
ViewR ([ListType], Seq Container)
Seq.EmptyR -> (Container -> [ListType]
getListTypes Container
cont,
([ListType], Seq Container) -> Seq ([ListType], Seq Container)
forall a. a -> Seq a
Seq.singleton (Container -> [ListType]
getListTypes Container
cont, Container -> Seq Container
forall a. a -> Seq a
Seq.singleton Container
cont))
Seq ([ListType], Seq Container)
rest Seq.:> ([ListType]
_, Seq Container
cur) ->
let lt :: [ListType]
lt = Container -> [ListType]
getListTypes Container
cont
matchedTypes :: [ListType]
matchedTypes = [ListType
ty | ListType
ty <- [ListType]
curtypes, (ListType -> Bool) -> [ListType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ListType
ty ListType -> ListType -> Bool
`matches`) [ListType]
lt]
in if [ListType] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ListType]
matchedTypes
then (Container -> [ListType]
getListTypes Container
cont, Seq ([ListType], Seq Container)
lists Seq ([ListType], Seq Container)
-> ([ListType], Seq Container) -> Seq ([ListType], Seq Container)
forall a. Seq a -> a -> Seq a
Seq.|> (Container -> [ListType]
getListTypes Container
cont, Container -> Seq Container
forall a. a -> Seq a
Seq.singleton Container
cont))
else ([ListType]
matchedTypes, Seq ([ListType], Seq Container)
rest Seq ([ListType], Seq Container)
-> ([ListType], Seq Container) -> Seq ([ListType], Seq Container)
forall a. Seq a -> a -> Seq a
Seq.|> ([ListType]
matchedTypes, Seq Container
cur Seq Container -> Container -> Seq Container
forall a. Seq a -> a -> Seq a
Seq.|> Container
cont))
matches :: ListType -> ListType -> Bool
matches :: ListType -> ListType -> Bool
matches (Bullet Char
b1) (Bullet Char
b2) = Char
b1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b2
matches (Ordered OrderedListAttributes
o1) (Ordered OrderedListAttributes
o2) =
OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
o1 OrderedListStyle -> OrderedListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
o2 Bool -> Bool -> Bool
&&
OrderedListAttributes -> OrderedListDelim
orderedListDelim OrderedListAttributes
o1 OrderedListDelim -> OrderedListDelim -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListAttributes -> OrderedListDelim
orderedListDelim OrderedListAttributes
o2
matches ListType
Definition ListType
Definition = Bool
True
matches Task{} Task{} = Bool
True
matches ListType
_ ListType
_ = Bool
False
getListTypes :: Container -> [ListType]
getListTypes :: Container -> [ListType]
getListTypes Container
cont = case Container -> ContainerData
containerData Container
cont of
ListItemData Int
_ [ListType]
tys Bool
_ -> [ListType]
tys
ContainerData
_ -> [Char] -> [ListType]
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing ListItemData"
pOrderedListStart :: P [ListType]
pOrderedListStart :: P [ListType]
pOrderedListStart = do
openParen <- (Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'(') P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
lookahead $ do
skipSome $ skipSatisfyByte (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c)
skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
stylesAndStarts <- decimalStart <|> romanStart <|> letterStart
delimType <-
if openParen
then LeftRightParen <$ asciiChar ')'
else (RightParen <$ asciiChar ')') <|> (RightPeriod <$ asciiChar '.')
followedByWhitespace
pure $ map
(\(OrderedListStyle
style, Int
start) -> OrderedListAttributes -> ListType
Ordered
OrderedListAttributes
{ orderedListStyle :: OrderedListStyle
orderedListStyle = OrderedListStyle
style
, orderedListDelim :: OrderedListDelim
orderedListDelim = OrderedListDelim
delimType
, orderedListStart :: Int
orderedListStart = Int
start }) stylesAndStarts
where
decimalStart :: Parser s [(OrderedListStyle, Int)]
decimalStart = do
digits <- Parser s Char -> Parser s [Char]
forall a. Parser s a -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte Char -> Bool
isDigit)
case readMaybe digits of
Just Int
n -> [(OrderedListStyle, Int)] -> Parser s [(OrderedListStyle, Int)]
forall a. a -> Parser s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(OrderedListStyle
Decimal, Int
n)]
Maybe Int
Nothing -> Parser s [(OrderedListStyle, Int)]
forall a. Parser s a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
letterStart :: Parser s [(OrderedListStyle, Int)]
letterStart = do
c <- (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte (\Char
c -> Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c)
if isAsciiLower c
then pure [(LetterLower, 1 + (ord c - ord 'a'))]
else pure [(LetterUpper, 1 + (ord c - ord 'A'))]
romanStart :: Parser PState [(OrderedListStyle, Int)]
romanStart = do
(n, lettercase) <- P (Int, Case)
pRomanNumeral
let sty = if Case
lettercase Case -> Case -> Bool
forall a. Eq a => a -> a -> Bool
== Case
Uppercase then OrderedListStyle
RomanUpper else OrderedListStyle
RomanLower
let altsty = if Case
lettercase Case -> Case -> Bool
forall a. Eq a => a -> a -> Bool
== Case
Uppercase then OrderedListStyle
LetterUpper else OrderedListStyle
LetterLower
pure $ (sty, n) :
case n of
Int
1 -> [(OrderedListStyle
altsty, Int
9)]
Int
5 -> [(OrderedListStyle
altsty, Int
22)]
Int
10 -> [(OrderedListStyle
altsty, Int
24)]
Int
50 -> [(OrderedListStyle
altsty, Int
12)]
Int
100 -> [(OrderedListStyle
altsty, Int
3)]
Int
500 -> [(OrderedListStyle
altsty, Int
4)]
Int
1000 -> [(OrderedListStyle
altsty, Int
13)]
Int
_ -> []
data Case = Uppercase | Lowercase
deriving (Case -> Case -> Bool
(Case -> Case -> Bool) -> (Case -> Case -> Bool) -> Eq Case
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Case -> Case -> Bool
== :: Case -> Case -> Bool
$c/= :: Case -> Case -> Bool
/= :: Case -> Case -> Bool
Eq)
pRomanNumeral :: P (Int, Case)
pRomanNumeral :: P (Int, Case)
pRomanNumeral = do
let isUpperRomanChar :: Char -> Bool
isUpperRomanChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'I' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'V' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'L' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'M'
let isLowerRomanChar :: Char -> Bool
isLowerRomanChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'i' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'v' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'l' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'c' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'd' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'm'
let isRomanChar :: Char -> Bool
isRomanChar Char
c = Char -> Bool
isUpperRomanChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLowerRomanChar Char
c
lettercase <- Parser PState Case -> Parser PState Case
forall s a. Parser s a -> Parser s a
lookahead (Parser PState Case -> Parser PState Case)
-> Parser PState Case -> Parser PState Case
forall a b. (a -> b) -> a -> b
$ do
c <- (Char -> Bool) -> Parser PState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte Char -> Bool
isRomanChar
let lettercase = if Char -> Bool
isUpperRomanChar Char
c then Case
Uppercase else Case
Lowercase
skipMany $ skipSatisfyByte $
case lettercase of
Case
Uppercase -> Char -> Bool
isUpperRomanChar
Case
Lowercase -> Char -> Bool
isLowerRomanChar
skipSatisfyByte (\Char
d -> Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
pure lettercase
let rchar Char
uc Char
lc = (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte ((Char -> Bool) -> Parser s Char)
-> (Char -> Bool) -> Parser s Char
forall a b. (a -> b) -> a -> b
$ if Case
lettercase Case -> Case -> Bool
forall a. Eq a => a -> a -> Bool
== Case
Uppercase
then (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
uc)
else (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
lc)
let one = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'I' Char
'i'
let five = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'V' Char
'v'
let ten = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'X' Char
'x'
let fifty = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'L' Char
'l'
let hundred = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'C' Char
'c'
let fivehundred = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'D' Char
'd'
let thousand = Char -> Char -> Parser s Char
forall {s}. Char -> Char -> Parser s Char
rchar Char
'M' Char
'm'
thousands <- (1000 *) . length <$> many thousand
ninehundreds <- option 0 $ hundred >> thousand >> return 900
fivehundreds <- option 0 $ 500 <$ fivehundred
fourhundreds <- option 0 $ hundred >> fivehundred >> return 400
hundreds <- (100 *) . length <$> many hundred
nineties <- option 0 $ ten >> hundred >> return 90
fifties <- option 0 (50 <$ fifty)
forties <- option 0 $ ten >> fifty >> return 40
tens <- (10 *) . length <$> many ten
nines <- option 0 $ one >> ten >> return 9
fives <- option 0 (5 <$ five)
fours <- option 0 $ one >> five >> return 4
ones <- length <$> many one
let total = Int
thousands Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ninehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fivehundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fourhundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
hundreds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nineties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fifties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forties Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nines Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
fives Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fours Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ones
if total == 0
then mzero
else return (total, lettercase)
where
option :: a -> f a -> f a
option a
defval f a
p = f a
p f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defval
listSpec :: BlockSpec
listSpec :: BlockSpec
listSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"List"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = P ()
forall a. Parser PState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
ListItem
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = (([ListType], Seq Container) -> Blocks)
-> Seq ([ListType], Seq Container) -> Blocks
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([ListType], Seq Container) -> Blocks
itemsToList (Seq ([ListType], Seq Container) -> Blocks)
-> (Container -> Seq ([ListType], Seq Container))
-> Container
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Container -> Seq ([ListType], Seq Container)
groupLists (Seq Container -> Seq ([ListType], Seq Container))
-> (Container -> Seq Container)
-> Container
-> Seq ([ListType], Seq Container)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Container -> Seq Container
containerChildren
}
itemsToList :: ([ListType], Seq Container) -> Blocks
itemsToList :: ([ListType], Seq Container) -> Blocks
itemsToList ([ListType]
ltypes, Seq Container
containers) =
case Seq Container
containers of
Seq Container
Seq.Empty -> Blocks
forall a. Monoid a => a
mempty
Seq Container
_ ->
let spacing :: ListSpacing
spacing =
case Seq Container -> ViewR Container
forall a. Seq a -> ViewR a
Seq.viewr Seq Container
containers of
ViewR Container
Seq.EmptyR -> ListSpacing
Tight
Seq Container
as Seq.:> Container
_ | (Container -> Bool) -> Seq Container -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Container -> Bool
itemEndsWithBlank Seq Container
as Bool -> Bool -> Bool
||
(Container -> Bool) -> Seq Container -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Container -> Bool
hasChildrenSeparatedWithBlank Seq Container
containers
-> ListSpacing
Loose
ViewR Container
_ -> ListSpacing
Tight
items' :: [Blocks]
items' = [Blocks] -> [Blocks]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Blocks]
items
taskListStatus :: [TaskStatus]
taskListStatus = (Container -> TaskStatus) -> [Container] -> [TaskStatus]
forall a b. (a -> b) -> [a] -> [b]
map Container -> TaskStatus
getTaskStatus (Seq Container -> [Container]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Container
containers)
pos :: Pos
pos = case (Seq Container -> ViewL Container
forall a. Seq a -> ViewL a
Seq.viewl Seq Container
containers, Seq Container -> ViewR Container
forall a. Seq a -> ViewR a
Seq.viewr Seq Container
containers) of
(Container
s Seq.:< Seq Container
_, Seq Container
_ Seq.:> Container
e) | Container -> Bool
containerSourcePos Container
s ->
Int -> Int -> Int -> Int -> Pos
Pos (Container -> Int
containerStartLine Container
s) (Container -> Int
containerStartColumn Container
s)
(Container -> Int
containerEndLine Container
e) (Container -> Int
containerEndColumn Container
e)
(ViewL Container, ViewR Container)
_ -> Pos
NoPos
in Pos -> Node Block -> Node Block
forall a. Pos -> Node a -> Node a
addPos Pos
pos (Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case [ListType]
ltypes of
Bullet{} : [ListType]
_-> ListSpacing -> [Blocks] -> Blocks
bulletList ListSpacing
spacing [Blocks]
items'
Ordered OrderedListAttributes
_ : [ListType]
_->
OrderedListAttributes -> ListSpacing -> [Blocks] -> Blocks
orderedList ([ListType] -> OrderedListAttributes
chooseOrderedAttr [ListType]
ltypes) ListSpacing
spacing [Blocks]
items'
ListType
Definition : [ListType]
_ -> ListSpacing -> [(Inlines, Blocks)] -> Blocks
definitionList ListSpacing
spacing ([(Inlines, Blocks)] -> Blocks) -> [(Inlines, Blocks)] -> Blocks
forall a b. (a -> b) -> a -> b
$ (Blocks -> (Inlines, Blocks)) -> [Blocks] -> [(Inlines, Blocks)]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> (Inlines, Blocks)
toDefinition [Blocks]
items'
Task TaskStatus
_ : [ListType]
_ -> ListSpacing -> [(TaskStatus, Blocks)] -> Blocks
taskList ListSpacing
spacing ([(TaskStatus, Blocks)] -> Blocks)
-> [(TaskStatus, Blocks)] -> Blocks
forall a b. (a -> b) -> a -> b
$ [TaskStatus] -> [Blocks] -> [(TaskStatus, Blocks)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TaskStatus]
taskListStatus [Blocks]
items'
[] -> Blocks
forall a. Monoid a => a
mempty
where
items :: [Blocks]
items = (Container -> Blocks) -> [Container] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Container -> Blocks
finalize ([Container] -> [Blocks]) -> [Container] -> [Blocks]
forall a b. (a -> b) -> a -> b
$ Seq Container -> [Container]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Container
containers
getTaskStatus :: Container -> TaskStatus
getTaskStatus Container
cont = case Container -> [ListType]
getListTypes Container
cont of
([Task TaskStatus
stat] :: [ListType]) -> TaskStatus
stat
[ListType]
_ -> [Char] -> TaskStatus
forall a. HasCallStack => [Char] -> a
error [Char]
"getTaskStatus: wrong shape"
chooseOrderedAttr :: [ListType] -> OrderedListAttributes
chooseOrderedAttr [ListType]
os =
case [OrderedListAttributes
at | Ordered OrderedListAttributes
at <- [ListType]
os, OrderedListAttributes -> Bool
isRomanStartOne OrderedListAttributes
at] of
(OrderedListAttributes
a:[OrderedListAttributes]
_) -> OrderedListAttributes
a
[OrderedListAttributes]
_ -> case [OrderedListAttributes
at | Ordered OrderedListAttributes
at <- [ListType]
os, OrderedListAttributes -> Bool
isLettered OrderedListAttributes
at] of
(OrderedListAttributes
a:[OrderedListAttributes]
_) -> OrderedListAttributes
a
[OrderedListAttributes]
_ -> case [OrderedListAttributes
at | Ordered OrderedListAttributes
at <- [ListType]
os] of
(OrderedListAttributes
a:[OrderedListAttributes]
_) -> OrderedListAttributes
a
[] -> [Char] -> OrderedListAttributes
forall a. HasCallStack => [Char] -> a
error [Char]
"chooseOrderedAttr on empty list"
isRomanStartOne :: OrderedListAttributes -> Bool
isRomanStartOne OrderedListAttributes
at = (OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
at OrderedListStyle -> OrderedListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListStyle
RomanUpper Bool -> Bool -> Bool
||
OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
at OrderedListStyle -> OrderedListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListStyle
RomanLower) Bool -> Bool -> Bool
&&
OrderedListAttributes -> Int
orderedListStart OrderedListAttributes
at Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
isLettered :: OrderedListAttributes -> Bool
isLettered OrderedListAttributes
at = OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
at OrderedListStyle -> OrderedListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListStyle
LetterUpper Bool -> Bool -> Bool
||
OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
at OrderedListStyle -> OrderedListStyle -> Bool
forall a. Eq a => a -> a -> Bool
== OrderedListStyle
LetterLower
itemEndsWithBlank :: Container -> Bool
itemEndsWithBlank :: Container -> Bool
itemEndsWithBlank Container
li =
case Seq Container -> ViewR Container
forall a. Seq a -> ViewR a
Seq.viewr (Container -> Seq Container
containerChildren Container
li) of
ViewR Container
Seq.EmptyR -> Bool
False
Seq Container
_ Seq.:> Container
lastChild -> Container -> Int
containerEndLine Container
li Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Container -> Int
containerEndLine Container
lastChild
hasChildrenSeparatedWithBlank :: Container -> Bool
hasChildrenSeparatedWithBlank :: Container -> Bool
hasChildrenSeparatedWithBlank Container
cont =
Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Seq Bool -> Bool) -> Seq Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Container -> Container -> Bool)
-> Seq Container -> Seq Container -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith Container -> Container -> Bool
check Seq Container
children (Int -> Seq Container -> Seq Container
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq Container
children)
where
children :: Seq Container
children = (if ListType
Definition ListType -> [ListType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ListType]
liTypes then Int -> Seq Container -> Seq Container
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 else Seq Container -> Seq Container
forall a. a -> a
id) (Seq Container -> Seq Container) -> Seq Container -> Seq Container
forall a b. (a -> b) -> a -> b
$
Container -> Seq Container
containerChildren Container
cont
check :: Container -> Container -> Bool
check Container
x Container
y = (BlockSpec -> [Char]
blockName (Container -> BlockSpec
containerSpec Container
y) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"List") Bool -> Bool -> Bool
&&
(Container -> Int
containerStartLine Container
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Container -> Int
containerEndLine Container
x)
liTypes :: [ListType]
liTypes = Container -> [ListType]
getListTypes Container
cont
toDefinition :: Blocks -> (Inlines, Blocks)
toDefinition :: Blocks -> (Inlines, Blocks)
toDefinition Blocks
bs =
case Seq (Node Block) -> ViewL (Node Block)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Node Block)
bs' of
Node Pos
_ Attr
_ (Para Inlines
ils) Seq.:< Seq (Node Block)
_ -> (Inlines
ils, Seq (Node Block) -> Blocks
forall a. Seq a -> Many a
Many (Int -> Seq (Node Block) -> Seq (Node Block)
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq (Node Block)
bs'))
ViewL (Node Block)
_ -> (Inlines
forall a. Monoid a => a
mempty, Blocks
bs)
where
bs' :: Seq (Node Block)
bs' = Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany Blocks
bs
sectionSpec :: BlockSpec
sectionSpec :: BlockSpec
sectionSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Section"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = P ()
forall a. Parser PState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
case Container -> Seq Container
containerChildren Container
container of
Container
h Seq.:<| Seq Container
_
| BlockSpec -> [Char]
blockName (Container -> BlockSpec
containerSpec Container
h) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Heading" -> do
let lev :: Int
lev = case Container -> ContainerData
containerData Container
container of
SectionData Int
n Maybe ByteString
_ -> Int
n
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing SectionData"
let ils :: Inlines
ils = case Container -> ContainerData
containerData Container
h of
HeadingData Int
_ Inlines
xs -> Inlines
xs
ContainerData
_ -> [Char] -> Inlines
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing HeadingData"
(secid, attr, label) <- do
let bs :: ByteString
bs = Inlines -> ByteString
inlinesToByteString Inlines
ils
let Attr [(ByteString, ByteString)]
ats = Container -> Attr
containerAttr Container
container
case ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"id" [(ByteString, ByteString)]
ats of
Just ByteString
id' -> (ByteString, Attr, ByteString)
-> Parser PState (ByteString, Attr, ByteString)
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
id', Attr
forall a. Monoid a => a
mempty, ByteString -> ByteString
normalizeLabel ByteString
bs)
Maybe ByteString
Nothing -> do
let generateId :: Int -> ByteString -> Parser PState ByteString
generateId (Int
n :: Int) ByteString
base = do
let candidate :: ByteString
candidate
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
base
| Bool
otherwise = ByteString
base ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
B8.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
ids <- PState -> Set ByteString
psIds (PState -> Set ByteString)
-> Parser PState PState -> Parser PState (Set ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
if candidate `Set.member` ids
then generateId (n+1) base
else do
updateState $ \PState
st ->
PState
st{ psIds = Set.insert candidate (psIds st)
, psAutoIds = Set.insert candidate
(psAutoIds st) }
pure candidate
ident <- Int -> ByteString -> Parser PState ByteString
generateId Int
0 (ByteString -> ByteString
toIdentifier ByteString
bs)
pure (ident, mempty, normalizeLabel bs)
let dest = ByteString
"#" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
secid
updateState $ \PState
st -> PState
st{ psAutoReferenceMap = insertReference label
(dest, Attr []) (psAutoReferenceMap st) }
pure container{ containerData =
SectionData lev (Just secid)
, containerAttr = containerAttr container <> attr }
Seq Container
_ -> Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Container
container
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
let blocks :: Blocks
blocks = Container -> Blocks
finalizeChildren Container
container
secid :: Maybe ByteString
secid = case Container -> ContainerData
containerData Container
container of
SectionData Int
_ Maybe ByteString
ident -> Maybe ByteString
ident
ContainerData
_ -> [Char] -> Maybe ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing SectionData"
in Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
(Node Block -> Node Block)
-> (ByteString -> Node Block -> Node Block)
-> Maybe ByteString
-> Node Block
-> Node Block
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Node Block -> Node Block
forall a. a -> a
id (\ByteString
ident -> Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
addAttr ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"id", ByteString
ident)])) Maybe ByteString
secid
(Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> Blocks
section Blocks
blocks
}
blockQuoteSpec :: BlockSpec
blockQuoteSpec :: BlockSpec
blockQuoteSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"BlockQuote"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
asciiChar '>'
followedByWhitespace
skipMany spaceOrTab
addContainer blockQuoteSpec ind NoData
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'>'
P ()
forall s. Parser s ()
followedByWhitespace
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Container -> Blocks
finalizeChildren Container
container
}
tableSpec :: BlockSpec
tableSpec :: BlockSpec
tableSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Table"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead P ()
pRawTableRow
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
addContainer tableSpec ind (TableData mempty)
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
let parsedBlankOrCaption :: Bool
parsedBlankOrCaption =
case Seq Chunk -> ViewR Chunk
forall a. Seq a -> ViewR a
Seq.viewr (Container -> Seq Chunk
containerText Container
container) of
Seq Chunk
_ Seq.:> Chunk
c -> Bool -> Bool
not ((Char -> Bool) -> ByteString -> Bool
B8.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|') (Chunk -> ByteString
chunkBytes Chunk
c))
ViewR Chunk
Seq.EmptyR -> Bool
False
(Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Bool -> P ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
parsedBlankOrCaption) P () -> P () -> P ()
forall a b. Parser PState a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead P ()
pRawTableRow))
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P ()
forall s. Parser s ()
followedByBlankLine)
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab P () -> P () -> P ()
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead (Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'^' P () -> P () -> P ()
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
forall s. Parser s ()
spaceOrTab)))
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> P ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Seq Container -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Container -> Seq Container
containerChildren Container
container))))
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
CaptionBlock
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
let lns :: Seq Chunk
lns = Container -> Seq Chunk
containerText Container
container
rows <- [[Cell]] -> [[Cell]]
forall a. [a] -> [a]
reverse ([[Cell]] -> [[Cell]])
-> (([Align], [[Cell]]) -> [[Cell]])
-> ([Align], [[Cell]])
-> [[Cell]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Align], [[Cell]]) -> [[Cell]]
forall a b. (a, b) -> b
snd (([Align], [[Cell]]) -> [[Cell]])
-> Parser PState ([Align], [[Cell]]) -> Parser PState [[Cell]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]]))
-> ([Align], [[Cell]])
-> Seq Chunk
-> Parser PState ([Align], [[Cell]])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]])
parseTableRow ([], []) Seq Chunk
lns
pure $ container{ containerData = TableData rows }
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
let rows :: [[Cell]]
rows = case Container -> ContainerData
containerData Container
container of
TableData [[Cell]]
rs -> [[Cell]]
rs
ContainerData
_ -> [Char] -> [[Cell]]
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing TableData"
mbCaption :: Maybe Caption
mbCaption =
case Seq Container -> ViewR Container
forall a. Seq a -> ViewR a
Seq.viewr (Container -> Seq Container
containerChildren Container
container) of
ViewR Container
Seq.EmptyR -> Maybe Caption
forall a. Maybe a
Nothing
Seq Container
_ Seq.:> Container
x -> Caption -> Maybe Caption
forall a. a -> Maybe a
Just (Caption -> Maybe Caption)
-> (Blocks -> Caption) -> Blocks -> Maybe Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Caption
Caption (Blocks -> Maybe Caption) -> Blocks -> Maybe Caption
forall a b. (a -> b) -> a -> b
$ BlockSpec -> Container -> Blocks
blockFinalize (Container -> BlockSpec
containerSpec Container
x) Container
x
in Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Maybe Caption -> [[Cell]] -> Blocks
table Maybe Caption
mbCaption [[Cell]]
rows
}
parseTableRow :: ([Align], [[Cell]])
-> Chunk
-> P ([Align], [[Cell]])
parseTableRow :: ([Align], [[Cell]]) -> Chunk -> Parser PState ([Align], [[Cell]])
parseTableRow ([Align]
aligns, [[Cell]]
rows) Chunk
chunk =
case ByteString -> Maybe (Char, ByteString)
B8.uncons (ByteString -> ByteString
B8.strip (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Chunk -> ByteString
chunkBytes Chunk
chunk) of
Just (Char
'|',ByteString
_) -> do
res <- [Align] -> Chunk -> P (Either [Align] [Cell])
pTableCells [Align]
aligns Chunk
chunk
case res of
Left [Align]
aligns' -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Align]
aligns',
case [[Cell]]
rows of
[Cell]
r:[[Cell]]
rs -> (Align -> Cell -> Cell) -> [Align] -> [Cell] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Align -> Cell -> Cell
toHeadCell [Align]
aligns' [Cell]
r [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: [[Cell]]
rs
[] -> [] )
Right [Cell]
cells -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Align]
aligns, [Cell]
cells [Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
: [[Cell]]
rows)
Maybe (Char, ByteString)
Nothing -> ([Align], [[Cell]]) -> Parser PState ([Align], [[Cell]])
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Align]
aligns, [[Cell]]
rows)
Just (Char
_,ByteString
_) -> Parser PState ([Align], [[Cell]])
forall a. Parser PState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
toHeadCell :: Align -> Cell -> Cell
toHeadCell Align
align' (Cell CellType
_ Align
_ Inlines
ils) = CellType -> Align -> Inlines -> Cell
Cell CellType
HeadCell Align
align' Inlines
ils
pTableCells :: [Align] -> Chunk -> P (Either [Align] [Cell])
pTableCells :: [Align] -> Chunk -> P (Either [Align] [Cell])
pTableCells [Align]
aligns Chunk
chunk =
case Parser () [Align] -> () -> [Chunk] -> Maybe [Align]
forall s a. Parser s a -> s -> [Chunk] -> Maybe a
parse Parser () [Align]
pTableSeps () [Chunk
chunk] of
Just [Align]
aligns' -> Either [Align] [Cell] -> P (Either [Align] [Cell])
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Align] [Cell] -> P (Either [Align] [Cell]))
-> Either [Align] [Cell] -> P (Either [Align] [Cell])
forall a b. (a -> b) -> a -> b
$ [Align] -> Either [Align] [Cell]
forall a b. a -> Either a b
Left [Align]
aligns'
Maybe [Align]
Nothing -> do
opts <- PState -> ParseOptions
psParseOptions (PState -> ParseOptions)
-> Parser PState PState -> Parser PState ParseOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
case parseTableCells opts chunk of
Right [Inlines]
cs ->
Either [Align] [Cell] -> P (Either [Align] [Cell])
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Align] [Cell] -> P (Either [Align] [Cell]))
-> Either [Align] [Cell] -> P (Either [Align] [Cell])
forall a b. (a -> b) -> a -> b
$ [Cell] -> Either [Align] [Cell]
forall a b. b -> Either a b
Right ([Cell] -> Either [Align] [Cell])
-> [Cell] -> Either [Align] [Cell]
forall a b. (a -> b) -> a -> b
$
(Align -> Inlines -> Cell) -> [Align] -> [Inlines] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CellType -> Align -> Inlines -> Cell
Cell CellType
BodyCell) ([Align]
aligns [Align] -> [Align] -> [Align]
forall a. [a] -> [a] -> [a]
++ Align -> [Align]
forall a. a -> [a]
repeat Align
AlignDefault) [Inlines]
cs
Left [Char]
_ -> P (Either [Align] [Cell])
forall a. Parser PState a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
pTableSeps :: Parser () [Align]
pTableSeps :: Parser () [Align]
pTableSeps = do
Parser () () -> Parser () ()
forall s a. Parser s a -> Parser s ()
skipMany Parser () ()
forall s. Parser s ()
spaceOrTab
Char -> Parser () ()
forall s. Char -> Parser s ()
asciiChar Char
'|'
Parser () Align -> Parser () [Align]
forall a. Parser () a -> Parser () [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser () Align
forall {s}. Parser s Align
pTableSep Parser () [Align] -> Parser () () -> Parser () [Align]
forall a b. Parser () a -> Parser () b -> Parser () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () () -> Parser () ()
forall s a. Parser s a -> Parser s ()
skipMany Parser () ()
forall s. Parser s ()
ws Parser () [Align] -> Parser () () -> Parser () [Align]
forall a b. Parser () a -> Parser () b -> Parser () a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () ()
forall s. Parser s ()
eof
where
pTableSep :: Parser s Align
pTableSep = do
Parser s () -> Parser s ()
forall s a. Parser s a -> Parser s ()
skipMany Parser s ()
forall s. Parser s ()
spaceOrTab
start <- (Bool
True Bool -> Parser s () -> Parser s Bool
forall a b. a -> Parser s b -> Parser s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser s ()
forall s. Char -> Parser s ()
asciiChar Char
':') Parser s Bool -> Parser s Bool -> Parser s Bool
forall a. Parser s a -> Parser s a -> Parser s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser s Bool
forall a. a -> Parser s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
skipSome (asciiChar '-')
end <- (True <$ asciiChar ':') <|> pure False
skipMany spaceOrTab
asciiChar '|'
pure $ case (start, end) of
(Bool
True, Bool
True) -> Align
AlignCenter
(Bool
True, Bool
False) -> Align
AlignLeft
(Bool
False, Bool
True) -> Align
AlignRight
(Bool
False, Bool
False) -> Align
AlignDefault
pRawTableRow :: P ()
pRawTableRow :: P ()
pRawTableRow = do
P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'|'
curline <- Parser PState Int
forall st. Parser st Int
sourceLine
curcolumn <- sourceColumn
bs <- restOfLine
void $ parseTableRow ([],[]) Chunk{ chunkLine = curline
, chunkColumn = curcolumn
, chunkBytes = bs }
captionSpec :: BlockSpec
captionSpec :: BlockSpec
captionSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Caption"
, blockType :: BlockType
blockType = BlockType
CaptionBlock
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
asciiChar '^'
void spaceOrTab
addContainer captionSpec ind $ CaptionData ind
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> (do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
curind <- Parser PState Int
forall st. Parser st Int
sourceColumn
let ind = case Container -> ContainerData
containerData Container
container of
CaptionData Int
i -> Int
i
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing CaptionData"
guard (curind > ind) <|> followedByBlankLine
pure True) P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = Container -> Blocks
finalizeChildren
}
thematicBreakSpec :: BlockSpec
thematicBreakSpec :: BlockSpec
thematicBreakSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"ThematicBreak"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
let breakChar :: Parser s ()
breakChar = (Char -> Bool) -> Parser s ()
forall s. (Char -> Bool) -> Parser s ()
skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')
Parser s () -> Parser s () -> Parser s ()
forall a b. Parser s a -> Parser s b -> Parser s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s () -> Parser s ()
forall s a. Parser s a -> Parser s ()
skipMany Parser s ()
forall s. Parser s ()
spaceOrTab
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
breakChar *> breakChar *> breakChar *> skipMany breakChar
lookahead endline
addContainer thematicBreakSpec ind NoData
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container -> Container -> Blocks -> Blocks
addSourcePos Container
container Blocks
thematicBreak
}
headingSpec :: BlockSpec
headingSpec :: BlockSpec
headingSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Heading"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
lev <- length <$> some (asciiChar '#')
followedByWhitespace
skipMany spaceOrTab
closeContainingSections lev
addContainer sectionSpec ind $ SectionData lev Nothing
addContainer headingSpec ind $ HeadingData lev mempty
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> do
do P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
let lev :: Int
lev = case Container -> ContainerData
containerData Container
container of
HeadingData Int
n Inlines
_ -> Int
n
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing HeadingData"
(Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do lev' <- [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([()] -> Int) -> Parser PState [()] -> Parser PState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P () -> Parser PState [()]
forall a. Parser PState a -> Parser PState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'#')
guard (lev' == lev)
skipMany spaceOrTab))
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
False Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead (Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'#' P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
forall s. Parser s ()
endline P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
forall s. Parser s ()
eof))
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
ils <- Container -> P Inlines
parseTextLines Container
container
let lev = case Container -> ContainerData
containerData Container
container of
HeadingData Int
n Inlines
_ -> Int
n
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing HeadingData"
pure $ container{ containerData = HeadingData lev ils }
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
let (Int
lev, Inlines
title) =
case Container -> ContainerData
containerData Container
container of
HeadingData Int
l Inlines
t -> (Int
l, Inlines
t)
ContainerData
_ -> [Char] -> (Int, Inlines)
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing HeadingData"
in Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Blocks
heading Int
lev Inlines
title
}
codeBlockSpec :: BlockSpec
codeBlockSpec :: BlockSpec
codeBlockSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"CodeBlock"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
indent <- Parser PState Int
forall st. Parser st Int
sourceColumn
ticks <- byteStringOf $ asciiChar '`' *> asciiChar '`' *> skipSome (asciiChar '`')
skipMany spaceOrTab
lang <- (byteStringOf
(skipSome $ skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isWs Char
c)))
<* skipMany spaceOrTab)
<|> pure ""
lookahead endline
addContainer codeBlockSpec indent (CodeBlockData ticks lang indent)
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> do
let (ByteString
ticks, Int
indent) = case Container -> ContainerData
containerData Container
container of
CodeBlockData ByteString
t ByteString
_ Int
i -> (ByteString
t, Int
i)
ContainerData
_ -> [Char] -> (ByteString, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing CodeBlockData"
Int -> P ()
gobbleSpaceToIndent Int
indent
(do P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
ByteString -> P ()
forall s. ByteString -> Parser s ()
byteString ByteString
ticks
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany (Char -> P ()
forall s. Char -> Parser s ()
asciiChar Char
'`')
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead P ()
forall s. Parser s ()
endline
Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
let lang :: ByteString
lang = case Container -> ContainerData
containerData Container
container of
CodeBlockData ByteString
_ ByteString
l Int
_ -> ByteString
l
ContainerData
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing CodeBlockData"
bs :: ByteString
bs = (Chunk -> ByteString) -> Seq Chunk -> ByteString
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Chunk -> ByteString
chunkBytes (Int -> Seq Chunk -> Seq Chunk
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 (Seq Chunk -> Seq Chunk) -> Seq Chunk -> Seq Chunk
forall a b. (a -> b) -> a -> b
$ Container -> Seq Chunk
containerText Container
container)
in Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
case ByteString -> Maybe (Char, ByteString)
B8.uncons ByteString
lang of
Just (Char
'=', ByteString
fmt) -> Format -> ByteString -> Blocks
rawBlock (ByteString -> Format
Format ByteString
fmt) ByteString
bs
Maybe (Char, ByteString)
_ -> ByteString -> ByteString -> Blocks
codeBlock ByteString
lang ByteString
bs
}
divSpec :: BlockSpec
divSpec :: BlockSpec
divSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Div"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
colons <- byteStringOf $
asciiChar ':' *> asciiChar ':' *> skipSome (asciiChar ':')
skipMany spaceOrTab
label <- byteStringOf $ skipMany $ skipSatisfyByte (not . isWs)
skipMany spaceOrTab
lookahead endline
addContainer divSpec ind (DivData colons label)
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> (do
tip <- P Container
getTip
guard $ blockName (containerSpec tip) /= "CodeBlock"
skipMany spaceOrTab
let colons = case Container -> ContainerData
containerData Container
container of
DivData ByteString
c ByteString
_ -> ByteString
c
ContainerData
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing DivData"
byteString colons
skipMany (asciiChar ':')
skipMany spaceOrTab
lookahead endline
pure False) P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockClose :: Container -> P Container
blockClose = Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
let label :: ByteString
label = case Container -> ContainerData
containerData Container
container of
DivData ByteString
_ ByteString
l -> ByteString
l
ContainerData
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing DivData"
bls :: Blocks
bls = Container -> Blocks
finalizeChildren Container
container
in (if ByteString -> Bool
B.null ByteString
label
then Node Block -> Node Block
forall a. a -> a
id
else Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
addAttr ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
label)])) (Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks
div Blocks
bls)
}
attrSpec :: BlockSpec
attrSpec :: BlockSpec
attrSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Attributes"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
lookahead $ asciiChar '{'
addContainer attrSpec ind $ AttributeData ind
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> do
let ind :: Int
ind = case Container -> ContainerData
containerData Container
container of
AttributeData Int
i -> Int
i
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing AttributeData"
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
curind <- Parser PState Int
forall st. Parser st Int
sourceColumn
mbapstate <- psAttrParserState <$> getState
if curind <= ind
then pure False
else do
let lastLine = case Seq Chunk -> ViewR Chunk
forall a. Seq a -> ViewR a
Seq.viewr (Container -> Seq Chunk
containerText Container
container) of
Seq Chunk
_ Seq.:> Chunk
ll -> Chunk -> ByteString
chunkBytes Chunk
ll
ViewR Chunk
_ -> ByteString
forall a. Monoid a => a
mempty
case parseAttributes mbapstate lastLine of
Done (Attr, Int)
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Partial AttrParserState
apstate' -> do
(PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ psAttrParserState = Just apstate' }
Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Failed Int
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
let bs :: ByteString
bs = (Chunk -> ByteString) -> Seq Chunk -> ByteString
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Chunk -> ByteString
chunkBytes (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
forall a b. (a -> b) -> a -> b
$ Container -> Seq Chunk
containerText Container
container
case Maybe AttrParserState -> ByteString -> AttrParseResult
parseAttributes Maybe AttrParserState
forall a. Maybe a
Nothing ByteString
bs of
Done (Attr
attr, Int
off)
| (Char -> Bool) -> ByteString -> Bool
B8.all Char -> Bool
isWs (Int -> ByteString -> ByteString
B8.drop Int
off ByteString
bs) -> do
(PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ psAttributes = psAttributes st <> attr }
Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Container
container
| Bool
otherwise -> do
ils <- Container -> P Inlines
parseTextLines Container
container
pure $ container{ containerSpec = paraSpec
, containerInlines = ils }
AttrParseResult
_ -> do
ils <- Container -> P Inlines
parseTextLines Container
container
pure $ container{ containerSpec = paraSpec
, containerInlines = ils }
, blockFinalize :: Container -> Blocks
blockFinalize = Blocks -> Container -> Blocks
forall a b. a -> b -> a
const Blocks
forall a. Monoid a => a
mempty
}
referenceDefinitionSpec :: BlockSpec
referenceDefinitionSpec :: BlockSpec
referenceDefinitionSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"ReferenceDefinition"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
asciiChar '['
fails (asciiChar '^')
label <- byteStringOf
(some (skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')))
asciiChar ']'
asciiChar ':'
skipMany spaceOrTab
addContainer referenceDefinitionSpec ind
(ReferenceData (normalizeLabel label))
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ ->
Bool
True Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P () -> P ()
forall s a. Parser s a -> Parser s ()
skipSome P ()
forall s. Parser s ()
spaceOrTab P () -> P () -> P ()
forall s a b. Parser s a -> Parser s b -> Parser s a
`notFollowedBy` P ()
forall s. Parser s ()
endline
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
let label :: ByteString
label = case Container -> ContainerData
containerData Container
container of
ReferenceData ByteString
l -> ByteString
l
ContainerData
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing ReferenceData"
let attr :: Attr
attr = Container -> Attr
containerAttr Container
container
let dest :: ByteString
dest = (Word8 -> Bool) -> ByteString -> ByteString
B.filter (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
32) (ByteString -> ByteString)
-> (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> ByteString) -> Seq Chunk -> ByteString
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Chunk -> ByteString
chunkBytes (Seq Chunk -> ByteString) -> Seq Chunk -> ByteString
forall a b. (a -> b) -> a -> b
$ Container -> Seq Chunk
containerText Container
container
(PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st ->
PState
st{ psReferenceMap = insertReference label (dest, attr)
(psReferenceMap st) }
Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Container
container
, blockFinalize :: Container -> Blocks
blockFinalize = Blocks -> Container -> Blocks
forall a b. a -> b -> a
const Blocks
forall a. Monoid a => a
mempty
}
footnoteSpec :: BlockSpec
=
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Footnote"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
asciiChar '['
asciiChar '^'
label <- byteStringOf
(some (skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')))
asciiChar ']'
asciiChar ':'
skipMany spaceOrTab
addContainer footnoteSpec ind $ FootnoteData ind (normalizeLabel label)
, blockContinue :: Container -> P Bool
blockContinue = \Container
container -> (do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
curind <- Parser PState Int
forall st. Parser st Int
sourceColumn
let ind = case Container -> ContainerData
containerData Container
container of
FootnoteData Int
i ByteString
_ -> Int
i
ContainerData
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing FootnoteData"
guard (curind > ind) <|> followedByBlankLine
pure True) P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just BlockType
Normal
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
let label :: ByteString
label = case Container -> ContainerData
containerData Container
container of
FootnoteData Int
_ ByteString
l -> ByteString
l
ContainerData
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing FootnoteData"
let bls :: Blocks
bls = Container -> Blocks
finalizeChildren Container
container
(PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ psNoteMap = insertNote label bls (psNoteMap st) }
Container -> P Container
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Container
container
, blockFinalize :: Container -> Blocks
blockFinalize = Blocks -> Container -> Blocks
forall a b. a -> b -> a
const Blocks
forall a. Monoid a => a
mempty
}
paraSpec :: BlockSpec
paraSpec :: BlockSpec
paraSpec =
BlockSpec
{ blockName :: [Char]
blockName = [Char]
"Para"
, blockType :: BlockType
blockType = BlockType
Normal
, blockStart :: P ()
blockStart = do
P () -> P ()
forall s a. Parser s a -> Parser s ()
fails P ()
forall s. Parser s ()
followedByBlankLine
ind <- Parser PState Int
forall st. Parser st Int
sourceColumn
addContainer paraSpec ind NoData
, blockContinue :: Container -> P Bool
blockContinue = \Container
_ -> do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
(Bool
False Bool -> P () -> P Bool
forall a b. a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P () -> P ()
forall s a. Parser s a -> Parser s a
lookahead (P ()
forall s. Parser s ()
endline P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P ()
forall s. Parser s ()
eof)) P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
, blockContainsBlock :: Maybe BlockType
blockContainsBlock = Maybe BlockType
forall a. Maybe a
Nothing
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockClose :: Container -> P Container
blockClose = \Container
container -> do
ils <- Container -> P Inlines
parseTextLines Container
container
pure $ container{ containerInlines = ils }
, blockFinalize :: Container -> Blocks
blockFinalize = \Container
container ->
Container -> Blocks -> Blocks
addSourcePos Container
container (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Container -> Inlines
containerInlines Container
container
}
parseTextLines :: Container -> P Inlines
parseTextLines :: Container -> P Inlines
parseTextLines Container
cont = do
opts <- PState -> ParseOptions
psParseOptions (PState -> ParseOptions)
-> Parser PState PState -> Parser PState ParseOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
either error pure . parseInlines opts $ containerText cont
emptyContainer :: Container
emptyContainer :: Container
emptyContainer =
Container { containerSpec :: BlockSpec
containerSpec = BlockSpec
docSpec
, containerChildren :: Seq Container
containerChildren = Seq Container
forall a. Monoid a => a
mempty
, containerText :: Seq Chunk
containerText = Seq Chunk
forall a. Monoid a => a
mempty
, containerInlines :: Inlines
containerInlines = Inlines
forall a. Monoid a => a
mempty
, containerStartLine :: Int
containerStartLine = Int
1
, containerStartColumn :: Int
containerStartColumn = Int
0
, containerEndLine :: Int
containerEndLine = Int
1
, containerEndColumn :: Int
containerEndColumn = Int
0
, containerData :: ContainerData
containerData = ContainerData
NoData
, containerAttr :: Attr
containerAttr = Attr
forall a. Monoid a => a
mempty
, containerSourcePos :: Bool
containerSourcePos = Bool
False
}
data Container =
Container
{ Container -> BlockSpec
containerSpec :: BlockSpec
, Container -> Seq Container
containerChildren :: Seq Container
, Container -> Seq Chunk
containerText :: Seq Chunk
, Container -> Inlines
containerInlines :: Inlines
, Container -> Int
containerStartLine :: Int
, Container -> Int
containerStartColumn :: Int
, Container -> Int
containerEndLine :: Int
, Container -> Int
containerEndColumn :: Int
, Container -> ContainerData
containerData :: ContainerData
, Container -> Attr
containerAttr :: Attr
, Container -> Bool
containerSourcePos :: Bool
}
data ContainerData =
NoData
| ListItemData Int [ListType] Bool
| SectionData Int (Maybe ByteString)
| HeadingData Int Inlines
| CodeBlockData ByteString ByteString Int
| DivData ByteString ByteString
| Int ByteString
| TableData [[Cell]]
| CaptionData Int
| AttributeData Int
| ReferenceData ByteString
deriving (Int -> ContainerData -> [Char] -> [Char]
[ContainerData] -> [Char] -> [Char]
ContainerData -> [Char]
(Int -> ContainerData -> [Char] -> [Char])
-> (ContainerData -> [Char])
-> ([ContainerData] -> [Char] -> [Char])
-> Show ContainerData
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ContainerData -> [Char] -> [Char]
showsPrec :: Int -> ContainerData -> [Char] -> [Char]
$cshow :: ContainerData -> [Char]
show :: ContainerData -> [Char]
$cshowList :: [ContainerData] -> [Char] -> [Char]
showList :: [ContainerData] -> [Char] -> [Char]
Show, ContainerData -> ContainerData -> Bool
(ContainerData -> ContainerData -> Bool)
-> (ContainerData -> ContainerData -> Bool) -> Eq ContainerData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContainerData -> ContainerData -> Bool
== :: ContainerData -> ContainerData -> Bool
$c/= :: ContainerData -> ContainerData -> Bool
/= :: ContainerData -> ContainerData -> Bool
Eq, Eq ContainerData
Eq ContainerData =>
(ContainerData -> ContainerData -> Ordering)
-> (ContainerData -> ContainerData -> Bool)
-> (ContainerData -> ContainerData -> Bool)
-> (ContainerData -> ContainerData -> Bool)
-> (ContainerData -> ContainerData -> Bool)
-> (ContainerData -> ContainerData -> ContainerData)
-> (ContainerData -> ContainerData -> ContainerData)
-> Ord ContainerData
ContainerData -> ContainerData -> Bool
ContainerData -> ContainerData -> Ordering
ContainerData -> ContainerData -> ContainerData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContainerData -> ContainerData -> Ordering
compare :: ContainerData -> ContainerData -> Ordering
$c< :: ContainerData -> ContainerData -> Bool
< :: ContainerData -> ContainerData -> Bool
$c<= :: ContainerData -> ContainerData -> Bool
<= :: ContainerData -> ContainerData -> Bool
$c> :: ContainerData -> ContainerData -> Bool
> :: ContainerData -> ContainerData -> Bool
$c>= :: ContainerData -> ContainerData -> Bool
>= :: ContainerData -> ContainerData -> Bool
$cmax :: ContainerData -> ContainerData -> ContainerData
max :: ContainerData -> ContainerData -> ContainerData
$cmin :: ContainerData -> ContainerData -> ContainerData
min :: ContainerData -> ContainerData -> ContainerData
Ord, Typeable)
data ListType =
Bullet Char
| Ordered OrderedListAttributes
| Definition
| Task TaskStatus
deriving (Int -> ListType -> [Char] -> [Char]
[ListType] -> [Char] -> [Char]
ListType -> [Char]
(Int -> ListType -> [Char] -> [Char])
-> (ListType -> [Char])
-> ([ListType] -> [Char] -> [Char])
-> Show ListType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ListType -> [Char] -> [Char]
showsPrec :: Int -> ListType -> [Char] -> [Char]
$cshow :: ListType -> [Char]
show :: ListType -> [Char]
$cshowList :: [ListType] -> [Char] -> [Char]
showList :: [ListType] -> [Char] -> [Char]
Show, Eq ListType
Eq ListType =>
(ListType -> ListType -> Ordering)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> ListType)
-> (ListType -> ListType -> ListType)
-> Ord ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListType -> ListType -> Ordering
compare :: ListType -> ListType -> Ordering
$c< :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
>= :: ListType -> ListType -> Bool
$cmax :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
min :: ListType -> ListType -> ListType
Ord, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
/= :: ListType -> ListType -> Bool
Eq)
data PState =
PState
{ PState -> ParseOptions
psParseOptions :: ParseOptions
, PState -> NonEmpty Container
psContainerStack :: NonEmpty Container
, PState -> ReferenceMap
psReferenceMap :: ReferenceMap
, PState -> ReferenceMap
psAutoReferenceMap :: ReferenceMap
, PState -> NoteMap
psNoteMap :: NoteMap
, PState -> Attr
psAttributes :: Attr
, PState -> Maybe AttrParserState
psAttrParserState :: Maybe AttrParserState
, PState -> Set ByteString
psIds :: Set ByteString
, PState -> Set ByteString
psAutoIds :: Set ByteString
, PState -> Int
psLastColumnPrevLine :: Int
, PState -> Int
psLastLine :: Int
}
type P = Parser PState
pDoc :: P Doc
pDoc :: Parser PState Doc
pDoc = do
bls <- P Blocks
pBlocks P Blocks -> P () -> P Blocks
forall a b. Parser PState a -> Parser PState b -> Parser PState a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
forall s. Parser s ()
eof
st <- getState
pure $ Doc{ docBlocks = bls
, docFootnotes = psNoteMap st
, docReferences = psReferenceMap st
, docAutoReferences = psAutoReferenceMap st
, docAutoIdentifiers = psAutoIds st }
pBlocks :: P Blocks
pBlocks :: P Blocks
pBlocks = P ()
processLines P () -> P Blocks -> P Blocks
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P Blocks
finalizeDocument
checkContinuations :: NonEmpty Container -> P Bool
checkContinuations :: NonEmpty Container -> P Bool
checkContinuations = [Container] -> P Bool
go ([Container] -> P Bool)
-> (NonEmpty Container -> [Container])
-> NonEmpty Container
-> P Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Container] -> [Container]
forall a. [a] -> [a]
reverse ([Container] -> [Container])
-> (NonEmpty Container -> [Container])
-> NonEmpty Container
-> [Container]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Container -> [Container]
forall a. NonEmpty a -> [a]
NonEmpty.toList
where
go :: [Container] -> P Bool
go [] = Bool -> P Bool
forall a. a -> Parser PState a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
go (Container
c:[Container]
cs) = do continue <- (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> P Bool -> Parser PState (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockSpec -> Container -> P Bool
blockContinue (Container -> BlockSpec
containerSpec Container
c) Container
c)
Parser PState (Maybe Bool)
-> Parser PState (Maybe Bool) -> Parser PState (Maybe Bool)
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Parser PState (Maybe Bool)
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
when (continue == Just False) $ do
curline <- sourceLine
curcol <- sourceColumn
updateState $ \PState
st ->
PState
st{ psLastLine = curline
, psLastColumnPrevLine = curcol - 1 }
if fromMaybe False continue
then go cs
else False <$
replicateM_ (length (c:cs)) closeCurrentContainer
{-# INLINE processLines #-}
processLines :: P ()
processLines :: P ()
processLines = do
containers <- PState -> NonEmpty Container
psContainerStack (PState -> NonEmpty Container)
-> Parser PState PState -> Parser PState (NonEmpty Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
allContainersMatch <- checkContinuations containers
newContainersAdded <- tryContainerStarts
followedByBlankLine <|> do
let isLazy = Bool -> Bool
not (Bool
allContainersMatch Bool -> Bool -> Bool
|| Bool
newContainersAdded) Bool -> Bool -> Bool
&&
BlockSpec -> [Char]
blockName (Container -> BlockSpec
containerSpec (NonEmpty Container -> Container
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty Container
containers)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Para"
when isLazy $
updateState (\PState
st -> PState
st{ psContainerStack = containers })
tip <- getTip
case blockContainsBlock (containerSpec tip) of
Just BlockType
bt | BlockType
bt BlockType -> BlockType -> Bool
forall a. Eq a => a -> a -> Bool
== BlockType
Normal Bool -> Bool -> Bool
|| BlockType
bt BlockType -> BlockType -> Bool
forall a. Eq a => a -> a -> Bool
== BlockType
ListItem -> do
P () -> P ()
forall s a. Parser s a -> Parser s ()
skipMany P ()
forall s. Parser s ()
spaceOrTab
BlockSpec -> P ()
blockStart BlockSpec
paraSpec
Maybe BlockType
_ -> () -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
!curline <- sourceLine
!curcolumn <- sourceColumn
restline <- byteStringOf $ do
skipMany (skipSatisfyByte (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'))
!lastcolumn <- sourceColumn
optional_ endline
updateState $ \PState
st -> PState
st{ psLastColumnPrevLine = lastcolumn - 1
, psLastLine = curline }
modifyContainers $
\(Container
c :| [Container]
rest) ->
if BlockSpec -> Bool
blockContainsLines (Container -> BlockSpec
containerSpec Container
c)
then Container
c{ containerText = containerText c Seq.|>
Chunk{ chunkLine = curline
, chunkColumn = curcolumn
, chunkBytes = restline } } Container -> [Container] -> NonEmpty Container
forall a. a -> [a] -> NonEmpty a
:| [Container]
rest
else Container
c Container -> [Container] -> NonEmpty Container
forall a. a -> [a] -> NonEmpty a
:| [Container]
rest
eof <|> processLines
tryContainerStarts :: P Bool
tryContainerStarts :: P Bool
tryContainerStarts = do
(c :| _) <- PState -> NonEmpty Container
psContainerStack (PState -> NonEmpty Container)
-> Parser PState PState -> Parser PState (NonEmpty Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
case blockContainsBlock (containerSpec c) of
Just BlockType
bt -> (do
nextc <- Parser PState Char -> Parser PState Char
forall s a. Parser s a -> Parser s a
lookahead ((Char -> Bool) -> Parser PState Char
forall s. (Char -> Bool) -> Parser s Char
satisfyByte Char -> Bool
isAscii)
next <- if nextc == ' ' || nextc == '\t'
then skipMany spaceOrTab *> lookahead (satisfyByte isAscii)
else pure nextc
case next of
Char
'>' -> BlockSpec -> P ()
blockStart BlockSpec
blockQuoteSpec
Char
'#' -> BlockSpec -> P ()
blockStart BlockSpec
headingSpec
Char
':' -> BlockSpec -> P ()
blockStart BlockSpec
divSpec P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BlockSpec -> P ()
blockStart BlockSpec
listItemSpec
Char
'*' -> BlockSpec -> P ()
blockStart BlockSpec
thematicBreakSpec P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BlockSpec -> P ()
blockStart BlockSpec
listItemSpec
Char
'-' -> BlockSpec -> P ()
blockStart BlockSpec
thematicBreakSpec P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BlockSpec -> P ()
blockStart BlockSpec
listItemSpec
Char
'`' -> BlockSpec -> P ()
blockStart BlockSpec
codeBlockSpec
Char
'{' -> BlockSpec -> P ()
blockStart BlockSpec
attrSpec
Char
'[' -> BlockSpec -> P ()
blockStart BlockSpec
referenceDefinitionSpec P () -> P () -> P ()
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BlockSpec -> P ()
blockStart BlockSpec
footnoteSpec
Char
'|' | BlockType
bt BlockType -> BlockType -> Bool
forall a. Eq a => a -> a -> Bool
/= BlockType
CaptionBlock -> BlockSpec -> P ()
blockStart BlockSpec
tableSpec
Char
'^' | BlockType
bt BlockType -> BlockType -> Bool
forall a. Eq a => a -> a -> Bool
== BlockType
CaptionBlock -> BlockSpec -> P ()
blockStart BlockSpec
captionSpec
Char
_ -> BlockSpec -> P ()
blockStart BlockSpec
listItemSpec
True <$ tryContainerStarts) P Bool -> P Bool -> P Bool
forall a. Parser PState a -> Parser PState a -> Parser PState a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Maybe BlockType
_ -> Bool -> P Bool
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
finalizeDocument :: P Blocks
finalizeDocument :: P Blocks
finalizeDocument = do
cs <- PState -> NonEmpty Container
psContainerStack (PState -> NonEmpty Container)
-> Parser PState PState -> Parser PState (NonEmpty Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
case cs of
Container
_ :| [] -> P ()
closeCurrentContainer P () -> P Blocks -> P Blocks
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Container -> Blocks
finalize (Container -> Blocks) -> P Container -> P Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Container
getTip
NonEmpty Container
_ -> P ()
closeCurrentContainer P () -> P Blocks -> P Blocks
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P Blocks
finalizeDocument
{-# INLINE closeCurrentContainer #-}
closeCurrentContainer :: P ()
closeCurrentContainer :: P ()
closeCurrentContainer = do
cs <- PState -> NonEmpty Container
psContainerStack (PState -> NonEmpty Container)
-> Parser PState PState -> Parser PState (NonEmpty Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
cs' <- case cs of
Container
_ :| [] -> NonEmpty Container -> Parser PState (NonEmpty Container)
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty Container
cs
Container
c :| [Container]
rest -> do
case Container -> Attr
containerAttr Container
c of
Attr [(ByteString, ByteString)]
as | Just ByteString
ident <- ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"id" [(ByteString, ByteString)]
as
-> (PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ psIds = Set.insert ident (psIds st) }
Attr
_ -> () -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
c' <- BlockSpec -> Container -> P Container
blockClose (Container -> BlockSpec
containerSpec Container
c) Container
c
pure (c':|rest)
case cs' of
Container
c :| (Container
d:[Container]
rest) -> (PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$
\PState
st -> PState
st{ psContainerStack =
d{ containerChildren = containerChildren d Seq.|>
c{ containerEndLine = psLastLine st
, containerEndColumn = psLastColumnPrevLine st } }
:| rest }
Container
c :| [] -> (PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$
\PState
st -> PState
st{ psContainerStack =
c{ containerEndLine = psLastLine st
, containerEndColumn = psLastColumnPrevLine st } :| [] }
{-# INLINE modifyContainers #-}
modifyContainers :: (NonEmpty Container -> NonEmpty Container) -> P ()
modifyContainers :: (NonEmpty Container -> NonEmpty Container) -> P ()
modifyContainers NonEmpty Container -> NonEmpty Container
f =
(PState -> PState) -> P ()
forall s. (s -> s) -> Parser s ()
updateState ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st{ psContainerStack = f (psContainerStack st) }
{-# INLINE addContainer #-}
addContainer :: BlockSpec -> Int -> ContainerData -> P ()
addContainer :: BlockSpec -> Int -> ContainerData -> P ()
addContainer BlockSpec
bspec Int
curcol ContainerData
bdata = do
curline <- Parser PState Int
forall st. Parser st Int
sourceLine
attr <- psAttributes <$> getState
opts <- psParseOptions <$> getState
let newcontainer = Container
emptyContainer { containerSpec = bspec
, containerStartLine = curline
, containerStartColumn = curcol
, containerEndLine = curline
, containerEndColumn = curcol
, containerData = bdata
, containerAttr = attr
, containerSourcePos = sourcePositions opts /= NoSourcePos }
unless (blockName bspec == "Attributes") $
updateState $ \PState
st -> PState
st{ psAttributes = mempty }
closeInappropriateContainers bspec
modifyContainers (newcontainer NonEmpty.<|)
closeInappropriateContainers :: BlockSpec -> P ()
closeInappropriateContainers :: BlockSpec -> P ()
closeInappropriateContainers BlockSpec
spec = do
cs <- PState -> NonEmpty Container
psContainerStack (PState -> NonEmpty Container)
-> Parser PState PState -> Parser PState (NonEmpty Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
case cs of
Container
c :| [Container]
_
| BlockSpec -> Maybe BlockType
blockContainsBlock (Container -> BlockSpec
containerSpec Container
c) Maybe BlockType -> Maybe BlockType -> Bool
forall a. Eq a => a -> a -> Bool
== BlockType -> Maybe BlockType
forall a. a -> Maybe a
Just (BlockSpec -> BlockType
blockType BlockSpec
spec) ->
() -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> P ()
closeCurrentContainer P () -> P () -> P ()
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BlockSpec -> P ()
closeInappropriateContainers BlockSpec
spec
finalize :: Container -> Blocks
finalize :: Container -> Blocks
finalize Container
cont =
Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
addAttr (Container -> Attr
containerAttr Container
cont)
(Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockSpec -> Container -> Blocks
blockFinalize (Container -> BlockSpec
containerSpec Container
cont) Container
cont
addSourcePos :: Container -> Blocks -> Blocks
addSourcePos :: Container -> Blocks -> Blocks
addSourcePos Container
cont =
if Container -> Bool
containerSourcePos Container
cont
then (Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Pos -> Node Block -> Node Block
forall a. Pos -> Node a -> Node a
addPos (Int -> Int -> Int -> Int -> Pos
Pos (Container -> Int
containerStartLine Container
cont) (Container -> Int
containerStartColumn Container
cont)
(Container -> Int
containerEndLine Container
cont) (Container -> Int
containerEndColumn Container
cont)))
else Blocks -> Blocks
forall a. a -> a
id
finalizeChildren :: Container -> Blocks
finalizeChildren :: Container -> Blocks
finalizeChildren = (Container -> Blocks) -> Seq Container -> Blocks
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Container -> Blocks
finalize (Seq Container -> Blocks)
-> (Container -> Seq Container) -> Container -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Container -> Seq Container
containerChildren
gobbleSpaceToIndent :: Int -> P ()
gobbleSpaceToIndent :: Int -> P ()
gobbleSpaceToIndent Int
indent = do
curindent <- Parser PState Int
forall st. Parser st Int
sourceColumn
when (curindent < indent) $
optional_ (spaceOrTab *> gobbleSpaceToIndent indent)
{-# INLINE getTip #-}
getTip :: P Container
getTip :: P Container
getTip = NonEmpty Container -> Container
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty Container -> Container)
-> (PState -> NonEmpty Container) -> PState -> Container
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> NonEmpty Container
psContainerStack (PState -> Container) -> Parser PState PState -> P Container
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PState PState
forall s. Parser s s
getState
closeContainingSections :: Int -> P ()
closeContainingSections :: Int -> P ()
closeContainingSections Int
lev = do
tip <- P Container
getTip
case containerData tip of
SectionData Int
lev' Maybe ByteString
_ | Int
lev' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lev ->
P ()
closeCurrentContainer P () -> P () -> P ()
forall a b. Parser PState a -> Parser PState b -> Parser PState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> P ()
closeContainingSections Int
lev
ContainerData
_ -> () -> P ()
forall a. a -> Parser PState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
toIdentifier :: ByteString -> ByteString
toIdentifier :: ByteString -> ByteString
toIdentifier ByteString
bs =
if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
parts
then ByteString
"sec"
else [Char] -> ByteString
strToUtf8 ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"-" [[Char]]
parts
where
isSym :: Char -> Bool
isSym = (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"][~!@#$%^&*(){}`,.<>\\|=+/" :: [Char]))
parts :: [[Char]]
parts = [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char -> Bool
isSym Char
c then Char
' ' else Char
c) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
utf8ToStr ByteString
bs