{-# LANGUAGE GADTs #-}

module Markup where

import           Data.List (intersperse)
import           Data.Monoid ((<>))
import           Data.Text (Text)
import qualified Data.Text as T
import           Lucid
import           Text.Megaparsec
import           Text.Megaparsec.Char

data Chunk
  = Bold   Text
  | Italic Text
  | Code   Text
  | Strike Text
  | Chunk  Text
    deriving (Eq, Show)

-- | Understands a very limited form of markup, and does not understand
--   nested markup yet.
markup :: Text -> Html ()
markup = div_
       . sequence_
       . intersperse (br_ [])
       . map (build . format)
       . T.lines

format :: Text -> [Chunk]
format t = case runParser parseF "[]" t of
  Left _   -> [Chunk t]
  Right cs -> cs

parseF :: (Stream s, Token s ~ Char) => Parsec () s [Chunk]
parseF = many go
  where go =  Bold   <$> delim '*'
          <|> Italic <$> delim '_'
          <|> Code   <$> delim '`'
          <|> Strike <$> delim '~'
          <|> (Chunk . T.pack) <$> pChunk
        delim c = (T.pack . (<> " ")) <$>
                  (char c *> manyTill asciiChar (try (char c >> space)))
        pChunk = some (noneOf ("*_`~" :: String))

build :: [Chunk] -> Html ()
build = mapM_ go
  where go (Chunk t)  = toHtml t
        go (Bold t)   = strong_ $ toHtml t
        go (Italic t) = em_ $ toHtml t
        go (Strike t) = span_ [ class_ "strike" ] $ toHtml t
        go (Code t)   = pre_ $ toHtml t