-{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.DTC.Write.Plain where
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
-import Data.String (String)
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..))
import Data.Tuple (fst, snd)
-import Data.String (IsString(..))
+import Data.String (String, IsString(..))
import Prelude (mod)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State as S
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
-import Data.Locale hiding (localize, Index)
+import Data.Locale hiding (Index)
import Language.DTC.Write.XML ()
+import Language.DTC.Document as DTC hiding (Plain)
import qualified Language.DTC.Document as DTC
-- * Type 'Plain'
= State
{ state_localize :: L10n -> Plain
, state_italic :: Bool
- , state_quote :: DTC.Nat
+ , state_quote :: Nat
}
instance Default State where
def = State
{ state_localize = plainify . show
, state_italic = False
- , state_quote = DTC.Nat 0
+ , state_quote = Nat 0
}
-
-- * Class 'Plainify'
class Plainify a where
plainify :: a -> Plain
plainify = return . TLB.fromText
instance Plainify TL.Text where
plainify = return . TLB.fromLazyText
-instance Plainify DTC.Para where
- plainify = foldMap plainify
-instance Plainify DTC.Lines where
+{-
+instance Plainify Para where
plainify = \case
- Tree0 v ->
- case v of
- DTC.BR -> "\n"
- DTC.Plain p -> plainify p
- TreeN k ls ->
- case k of
- DTC.B -> "*"<>plainify ls<>"*"
- DTC.Code -> "`"<>plainify ls<>"`"
- DTC.Del -> "-"<>plainify ls<>"-"
- DTC.I -> "/"<>plainify ls<>"/"
- DTC.Note -> ""
- DTC.Q ->
- let depth = DTC.Nat 0 in
- plainify (L10n_QuoteOpen{..}) <>
+ ParaItem{..} -> plainify item
+ ParaItems{..} -> plainify items
+-}
+instance Plainify DTC.Plain where
+ plainify = foldMap plainify
+instance Plainify (Tree PlainNode) where
+ plainify (Tree n ls) =
+ case n of
+ PlainBR -> "\n"
+ PlainText txt -> plainify txt
+ PlainGroup -> plainify ls
+ PlainB -> "*"<>plainify ls<>"*"
+ PlainCode -> "`"<>plainify ls<>"`"
+ PlainDel -> "-"<>plainify ls<>"-"
+ PlainI -> "/"<>plainify ls<>"/"
+ PlainNote{..} -> "" -- TODO: to be coded, with a switch on/off in State
+ PlainQ ->
+ let depth = Nat 0 in
+ plainify L10n_QuoteOpen{..} <>
plainify ls <>
- plainify (L10n_QuoteClose{..})
- DTC.SC -> plainify ls
- DTC.Sub -> plainify ls
- DTC.Sup -> plainify ls
- DTC.U -> "_"<>plainify ls<>"_"
- DTC.Eref{..} -> plainify ls
- DTC.Iref{..} -> plainify ls
- DTC.Ref{..} -> plainify ls
- DTC.Rref{..} -> plainify ls
-instance Plainify DTC.Title where
- plainify (DTC.Title t) = plainify t
-instance Plainify DTC.PosPath where
+ plainify L10n_QuoteClose{..}
+ PlainSC -> plainify ls
+ PlainSub -> plainify ls
+ PlainSup -> plainify ls
+ PlainU -> "_"<>plainify ls<>"_"
+ PlainEref{..} -> plainify ls
+ PlainIref{..} -> plainify ls
+ PlainRef{..} -> plainify ls
+ PlainRref{..} -> plainify ls
+instance Plainify Title where
+ plainify (Title t) = plainify t
+instance Plainify PosPath where
plainify =
plainify .
snd . foldl' (\(nParent,acc) (n,c) ->
)
)
("","")
-instance Plainify DTC.XmlName where
+instance Plainify XmlName where
plainify = plainify . show
instance Plainify Int where
plainify = plainify . show
-instance Plainify DTC.Nat where
- plainify (DTC.Nat n) = plainify n
-instance Plainify DTC.Nat1 where
- plainify (DTC.Nat1 n) = plainify n
+instance Plainify Nat where
+ plainify (Nat n) = plainify n
+instance Plainify Nat1 where
+ plainify (Nat1 n) = plainify n
-- * Type 'L10n'
data L10n
= L10n_Table_of_Contents
| L10n_Colon
- | L10n_QuoteOpen {depth :: DTC.Nat}
- | L10n_QuoteClose {depth :: DTC.Nat}
- | L10n_Date DTC.Date
+ | L10n_QuoteOpen {depth :: Nat}
+ | L10n_QuoteClose {depth :: Nat}
+ | L10n_Date Date
deriving (Show)
instance Plainify L10n where
plainify msg = do
instance LocalizeIn FR Plain L10n where
localizeIn _ = \case
L10n_Table_of_Contents -> "Sommaire"
- L10n_Colon -> " :"
+ L10n_Colon -> " : "
L10n_QuoteOpen{..} ->
- case DTC.unNat depth `mod` 3 of
+ case unNat depth `mod` 3 of
0 -> "« "
1 -> "“"
_ -> "‟"
L10n_QuoteClose{..} ->
- case DTC.unNat depth `mod` 3 of
+ case unNat depth `mod` 3 of
0 -> " »"
1 -> "”"
_ -> "„"
- L10n_Date DTC.Date{..} ->
+ L10n_Date Date{..} ->
mconcat $
List.intersperse " " $
concat
[ maybe [] (pure . plainify) day
, case month of
Nothing -> []
- Just (DTC.Nat1 m) ->
+ Just (Nat1 m) ->
case m of
1 -> pure "janvier"
2 -> pure "février"
instance LocalizeIn EN Plain L10n where
localizeIn _ = \case
L10n_Table_of_Contents -> "Summary"
- L10n_Colon -> ":"
+ L10n_Colon -> ": "
L10n_QuoteOpen{..} ->
- case DTC.unNat depth `mod` 3 of
+ case unNat depth `mod` 3 of
0 -> "“"
1 -> "« "
_ -> "‟"
L10n_QuoteClose{..} ->
- case DTC.unNat depth `mod` 3 of
+ case unNat depth `mod` 3 of
0 -> "”"
1 -> " »"
_ -> "„"
- L10n_Date DTC.Date{..} ->
+ L10n_Date Date{..} ->
mconcat $
List.intersperse " " $
concat
[ maybe [] (pure . plainify) day
, case month of
Nothing -> []
- Just (DTC.Nat1 m) ->
+ Just (Nat1 m) ->
case m of
1 -> pure "January"
2 -> pure "February"