Framework for BBCode Syntax tree -> Printout morph

1 files changed, 45 insertions, 0 deletions

diff --git a/spec/src/Thermoprint/Printout/BBCode.hs b/spec/src/Thermoprint/Printout/BBCode.hs
new file mode 100644
index 0000000..8d98da1
--- /dev/null
+++ b/spec/src/Thermoprint/Printout/BBCode.hs
@@ -0,0 +1,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