aboutsummaryrefslogtreecommitdiff
path: root/spec/src/Thermoprint/Printout/BBCode.hs
blob: 8d98da16985e3f7cacd7900324746156c06afef3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Thermoprint.Printout.BBCode
       ( bbcode
       , TreeError(..)
       ) where

import Data.Text (Text)
import qualified Data.Text as T ()

import GHC.Generics (Generic)
import Control.Exception (Exception)
import Data.Typeable (Typeable)

import Data.Bifunctor (bimap, first)
import Control.Monad (join)

import Text.BBCode (DomTree(..), TreeError(..))
import qualified Text.BBCode as Raw (bbcode, BBCodeError(..))

import Thermoprint.Printout

-- ^ We replicate 'Raw.BBCodeError' but add a new failure mode documenting incompatibly of the parsed syntax tree with our document format
data BBCodeError = LexerError String -- ^ Error while parsing input to stream of tokens
                 | TreeError TreeError -- ^ Error while parsing stream of tokens to syntax tree
                 | SemanticError SemanticError -- ^ Error while mapping syntax tree to document format
                 deriving (Show, Eq, Generic, Typeable)

instance Exception BBCodeError

data SemanticError = Placeholder
  deriving (Show, Eq, Generic, Typeable)

instance Exception SemanticError

bbcode :: Text -> Either BBCodeError Printout
bbcode = join . fmap (first SemanticError) . bimap morph' morph . Raw.bbcode

morph' :: Raw.BBCodeError -> BBCodeError
morph' (Raw.LexerError x) = LexerError x
morph' (Raw.TreeError x) = TreeError x

morph :: [DomTree] -> Either SemanticError Printout
morph = undefined