141 lines
3.5 KiB
Haskell
141 lines
3.5 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, Eq)
|
|
|
|
data DocHeader = DocHead
|
|
{ _docTitle :: Text
|
|
} deriving (Show, Eq)
|
|
|
|
data Section = Sec
|
|
{ _secAttrs :: Attributes
|
|
, _secTitle :: Text
|
|
, _secBody :: Maybe SectionBody
|
|
, _secChildren :: Seq Section
|
|
} deriving (Show, Eq)
|
|
|
|
type SectionBody = Seq Block
|
|
|
|
data Block = Block
|
|
{ _blockKind :: BlockKind
|
|
, _blockAttrs :: Attributes
|
|
, _blockTitle :: Maybe Text
|
|
} deriving (Show, Eq)
|
|
|
|
data BlockKind = Paragraph
|
|
| DelimBlock
|
|
| List
|
|
deriving (Show, Eq)
|
|
|
|
data Inlines = TextChunk Text
|
|
deriving (Show, Eq)
|
|
|
|
data AuthorInfo = Author
|
|
{ _firstName :: [Text]
|
|
, _middleName :: Maybe [Text]
|
|
, _lastName :: Maybe [Text]
|
|
, _email :: Maybe Text
|
|
} deriving (Show, Eq)
|
|
|
|
data RevisionInfo = Rev
|
|
{ _revNum :: Maybe Text
|
|
, _revDate :: Maybe Text
|
|
, _revRemark :: Maybe Text
|
|
} deriving (Show, Eq)
|
|
|
|
data AttrEntry = Attr
|
|
{ _attName :: Text
|
|
, _attVal :: Text
|
|
} deriving (Show, Eq)
|
|
|
|
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"
|
|
|
|
pAuthorLine :: Parser AuthorInfo
|
|
pAuthorLine = do
|
|
author <- collapseSp <$> takeTill (\c -> c == '<' || isEndOfLine c)
|
|
let (f, m, l) = case T.words author of
|
|
(frst : mid : lst : []) ->
|
|
(T.splitOn "_" frst, Just $ T.splitOn "_" mid, Just $ T.splitOn "_" lst)
|
|
(frst : lst : []) ->
|
|
(T.splitOn "_" frst, Nothing, Just $ T.splitOn "_" lst)
|
|
(frst : []) ->
|
|
(T.splitOn "_" frst, Nothing, Nothing)
|
|
_ -> ([author], Nothing, Nothing)
|
|
email <- do char '<'
|
|
em <- takeTill (== '>')
|
|
char '>'
|
|
return (Just em)
|
|
<|> return Nothing
|
|
satisfy isEndOfLine
|
|
return (Author f m l email)
|
|
|
|
pRevInfo :: Parser RevisionInfo
|
|
pRevInfo = pStdRevInfo <|> pRCSInfo <|> pure (Rev Nothing Nothing Nothing)
|
|
where
|
|
pStdRevInfo = fail "NotImpl"
|
|
pRCSInfo = fail "NotImpl"
|
|
|
|
pAttributeEntry :: Parser AttrEntry
|
|
pAttributeEntry = undefined
|