{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module Celtchar.Novel.Ogmarkup where

import           Data.String
import           Data.Text                (Text, append)
import           Text.Ogmarkup
import           Text.Shakespeare.Text

import           Celtchar.Novel.Structure (Language (..))

data NovConf (l :: Language)

class HasTypo (l :: Language) where
  toTypo :: IsString a => Typography a

instance HasTypo French where
  toTypo = frenchTypo

instance HasTypo English where
  toTypo = englishTypo

el :: Text
el = "\n\n"

blk :: Text
    -> Text
blk = (`append` el)

instance HasTypo l => GenConf (NovConf l) Text where
    typography = toTypo @l

    printSpace None   = ""
    printSpace Normal = " "
    printSpace Nbsp   = "~"

    betweenDialogue = el

    storyTemplate sec = blk [st|\paragraph{} #{sec}|]

    paragraphTemplate = blk

    dialogueTemplate _ txt = [st|\dialogue{}#{txt}|]
    thoughtTemplate _ txt = [st|\thought{}#{txt}|]
    replyTemplate txt = [st|\reply{#{txt}}|]

    strongEmphTemplate txt = [st|\textbf{#{txt}}|]
    emphTemplate txt = [st|\textit{#{txt}}|]

parseDoc :: Language
         -> Text
         -> Text
parseDoc French  = ogmarkup @(NovConf French)
parseDoc English = ogmarkup @(NovConf English)