Initial commit for hasciidoc

src/Hasciidoc.hs

@@ -0,0 +1,95 @@
+{-# 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"
+