96 lines
2.2 KiB
Haskell
96 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
|
|
|
|
module Hasciidoc where
|
|
|
|
import Control.Applicative
|
|
import Data.Attoparsec.Text
|
|
import Data.Char
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as M
|
|
import Data.Sequence (Seq)
|
|
import qualified Data.Sequence as S
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
|
|
type Attributes = Map Text Text
|
|
|
|
data Document = Doc
|
|
{ _docAttrs :: Attributes
|
|
, _header :: Maybe DocHeader
|
|
, _preamble :: Maybe SectionBody
|
|
, _sections :: Seq Section
|
|
} deriving (Show)
|
|
|
|
data DocHeader = DocHead
|
|
{ _docTitle :: Text
|
|
} deriving (Show)
|
|
|
|
data Section = Sec
|
|
{ _secAttrs :: Attributes
|
|
, _secTitle :: Text
|
|
, _secBody :: Maybe SectionBody
|
|
, _secChildren :: Seq Section
|
|
} deriving (Show)
|
|
|
|
type SectionBody = Seq Block
|
|
|
|
data Block = Block
|
|
{ _blockKind :: BlockKind
|
|
, _blockAttrs :: Attributes
|
|
, _blockTitle :: Maybe Text
|
|
} deriving (Show)
|
|
|
|
data BlockKind = Paragraph
|
|
| DelimBlock
|
|
| List
|
|
deriving (Show)
|
|
|
|
data Inlines = TextChunk Text
|
|
deriving (Show)
|
|
|
|
pCountedChar :: Char -> Parser Int
|
|
pCountedChar c = ((+) <$> (char c >> pure 1) <*> pCountedChar c)
|
|
<|> pure 0
|
|
|
|
collapseSp = T.unwords . T.words
|
|
|
|
|
|
pTitle :: Parser (Int, Text)
|
|
pTitle = pOneLineTitle <|> pUnderTitle
|
|
|
|
pOneLineTitle :: Parser (Int, Text)
|
|
pOneLineTitle = (,) <$ char '='
|
|
<*> pCountedChar '='
|
|
<* space
|
|
<* skipSpace
|
|
<*> (collapseSp <$> takeTill (\c -> c == '=' || isEndOfLine c))
|
|
<* takeTill isEndOfLine
|
|
<* satisfy isEndOfLine
|
|
<?> "pOneLineTitle"
|
|
|
|
pUnderTitle :: Parser (Int, Text)
|
|
pUnderTitle = flip (,) <$> (collapseSp <$> takeTill isEndOfLine)
|
|
<* satisfy isEndOfLine
|
|
<*> pTitleUnderline
|
|
<?> "pUnderTitle"
|
|
|
|
pTitleUnderline :: Parser Int
|
|
pTitleUnderline = do
|
|
c <- anyChar
|
|
char c
|
|
takeTill (not . (== c))
|
|
satisfy isEndOfLine
|
|
titleCharLevel c
|
|
|
|
|
|
titleCharLevel :: Monad m => Char -> m Int
|
|
titleCharLevel c = case c of
|
|
'=' -> return 0
|
|
'-' -> return 1
|
|
'~' -> return 2
|
|
'^' -> return 3
|
|
'+' -> return 4
|
|
_ -> fail "Bad title underline character"
|
|
|