{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE LambdaCase            #-}
{-# 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 $ \case
    Semicolon        -> ";"
    Colon            -> ":"
    Question         -> "?"
    Exclamation      -> "!"
    OpenQuote        -> "\\og{}"
    CloseQuote       -> "\\fg{}"
    Dash             -> "--"
    LongDash         -> "---"
    Comma            -> ","
    Point            -> "."
    Hyphen           -> "-"
    SuspensionPoints -> "…"
    Apostrophe       -> "’"
    Interrobang      -> "\\interrobang"
    Irony            -> "\\ironymark"


instance HasTypo English where
  toTypo = englishTypo $ \case
    Semicolon        -> ";"
    Colon            -> ":"
    Question         -> "?"
    Exclamation      -> "!"
    OpenQuote        -> "``"
    CloseQuote       -> "''"
    Dash             -> "--"
    LongDash         -> "---"
    Comma            -> ","
    Point            -> "."
    Hyphen           -> "-"
    SuspensionPoints -> "\\ldots"
    Apostrophe       -> "’"
    Interrobang      -> "\\interrobang"
    Irony            -> "\\ironymark"

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   = "" -- we let babel and ogma.sty deal with typography

    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)