+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.DTC.Write.HTML5 where
--- import Control.Monad.Trans.Class (MonadTrans(..))
--- import Data.Functor.Identity (Identity(..))
--- import Data.Sequence (Seq)
--- import Data.Set (Set)
--- import Data.Traversable (Traversable(..))
--- import qualified Data.Sequence as Seq
--- import qualified Data.TreeSeq.Strict as Tree
import Control.Applicative (Applicative(..))
-import Control.Category
+import Control.Category as Cat
import Control.Monad
import Data.Bool
import Data.Char (Char)
import Data.Default.Class (Default(..))
-import Data.Foldable (Foldable(..), concat)
-import Data.Function (($), const, flip, on)
-import Data.Functor (Functor(..), (<$>))
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Foldable (Foldable(..), concat, any)
+import Data.Function (($), const, on)
+import Data.Functor ((<$>))
import Data.Functor.Compose (Compose(..))
import Data.Int (Int)
import Data.Map.Strict (Map)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
-import Data.String (String)
+import Data.String (String, IsString(..))
import Data.Text (Text)
-import Data.TreeSeq.Strict (Tree(..), Trees)
+import Data.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (snd)
+import Prelude (mod)
import System.FilePath (FilePath)
import Text.Blaze ((!))
import Text.Blaze.Html (Html)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State as S
-import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.TreeMap.Strict as TreeMap
-import qualified Data.TreeSeq.Strict as Tree
import qualified Data.TreeSeq.Strict.Zipper as Tree
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Text.Blaze.Internal as H
import Text.Blaze.Utils
-import Data.Locale hiding (localize, Index)
-import qualified Data.Locale as Locale
+import Data.Locale hiding (Index)
+import Language.DTC.Document as DTC
+import Language.DTC.Write.Plain (Plainify(..))
import Language.DTC.Write.XML ()
-import Language.DTC.Write.Plain (Plain, Plainify(..))
-import qualified Language.DTC.Write.Plain as Plain
-import qualified Language.DTC.Document as DTC
import qualified Language.DTC.Anchor as Anchor
+import qualified Language.DTC.Write.Plain as Plain
+
+writeHTML5 :: Config -> DTC.Document -> Html
+writeHTML5 conf@Config{..} DTC.Document{..} = do
+ let Keys{..} = keys body `S.execState` def
+ let (body',state_rrefs,state_notes,state_indexs) =
+ let irefs = foldMap Anchor.irefsOfTerms keys_index in
+ let (body0, Anchor.State{state_irefs, state_rrefs=rrefs, state_notes=notes}) =
+ Anchor.anchorify body `S.runState`
+ def{Anchor.state_irefs=irefs} in
+ (body0,rrefs,notes,) $
+ (<$> keys_index) $ \terms ->
+ (terms,) $
+ TreeMap.intersection const state_irefs $
+ Anchor.irefsOfTerms terms
+ let state_plainify = def{ Plain.state_l10n = loqualize config_locale}
+ let (html5Body, endState) =
+ runStateMarkup def
+ { state_indexs
+ , state_rrefs
+ , state_notes
+ , state_figures = keys_figure
+ , state_references = keys_reference
+ , state_plainify
+ , state_l10n = loqualize config_locale
+ } $ do
+ html5DocumentHead head
+ html5ify body'
+ H.docType
+ H.html ! HA.lang (attrify $ countryCode config_locale) $ do
+ html5Head conf endState head body
+ H.body $ html5Body
+
+html5Head :: Config -> State -> Head -> Body -> Html
+html5Head Config{..} State{..} Head{DTC.about=About{..}} body = do
+ H.head $ do
+ H.meta ! HA.httpEquiv "Content-Type"
+ ! HA.content "text/html; charset=UTF-8"
+ unless (null titles) $ do
+ H.title $
+ H.toMarkup $ Plain.text state_plainify $ List.head titles
+ forM_ links $ \Link{rel, href} ->
+ H.link ! HA.rel (attrify rel)
+ ! HA.href (attrify href)
+ forM_ url $ \href ->
+ H.link ! HA.rel "self"
+ ! HA.href (attrify href)
+ unless (TL.null config_generator) $ do
+ H.meta ! HA.name "generator"
+ ! HA.content (attrify config_generator)
+ unless (null tags) $
+ H.meta ! HA.name "keywords"
+ ! HA.content (attrify $ TL.intercalate ", " tags)
+ let chapters =
+ (`mapMaybe` toList body) $ \case
+ Tree k@BodySection{} _ -> Just k
+ _ -> Nothing
+ forM_ chapters $ \case
+ BodySection{..} ->
+ H.link ! HA.rel "Chapter"
+ ! HA.title (attrify $ plainify title)
+ ! HA.href ("#"<>attrify pos)
+ _ -> mempty
+ unless (any (\DTC.Link{rel} -> rel == "stylesheet") links) $ do
+ case config_css of
+ Left "" -> mempty
+ Left css ->
+ H.link ! HA.rel "stylesheet"
+ ! HA.type_ "text/css"
+ ! HA.href (attrify css)
+ Right css ->
+ H.style ! HA.type_ "text/css" $
+ -- NOTE: as a special case, H.style wraps its content into an External,
+ -- so it does not HTML-escape its content.
+ H.toMarkup css
+ forM_ state_styles $ \style ->
+ H.style ! HA.type_ "text/css" $
+ H.toMarkup style
+ unless (any (\DTC.Link{rel} -> rel == "script") links) $ do
+ forM_ state_scripts $ \script ->
+ H.script ! HA.type_ "application/javascript" $
+ H.toMarkup script
-(<&>) :: Functor f => f a -> (a -> b) -> f b
-(<&>) = flip (<$>)
-infixl 4 <&>
+html5DocumentHead :: Head -> Html5
+html5DocumentHead Head{DTC.about=About{..}} = do
+ H.div ! HA.class_ "document-head" $$
+ H.table $$ do
+ H.tbody $$ do
+ H.tr $$ do
+ H.td ! HA.class_ "left" $$ docHeaders
+ H.td ! HA.class_ "right" $$ docAuthors
+ unless (null titles) $
+ H.div ! HA.class_ "title" $$ do
+ forM_ titles $ \title ->
+ H.h1 $$ html5ify title
+ where
+ docHeaders =
+ H.table ! HA.class_ "document-headers" $$
+ H.tbody $$ do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ forM_ series $ \s@Serie{id=id_, name} ->
+ header $
+ case urlSerie s of
+ Nothing -> do
+ headerName $ html5ify name
+ headerValue $ html5ify id_
+ Just href -> do
+ headerName $ html5ify name
+ headerValue $
+ H.a ! HA.href (attrify href) $$
+ html5ify id_
+ forM_ date $ \d ->
+ header $ do
+ headerName $ l10n_Header_Date loc
+ headerValue $ html5ify d
+ forM_ url $ \href ->
+ header $ do
+ headerName $ l10n_Header_Address loc
+ headerValue $ html5ify $ tree0 $ PlainEref{href}
+ forM_ links $ \Link{..} ->
+ unless (TL.null name) $
+ header $ do
+ headerName $ html5ify name
+ headerValue $ html5ify $ Tree PlainEref{href} plain
+ forM_ headers $ \Header{..} ->
+ header $ do
+ headerName $ html5ify name
+ headerValue $ html5ify value
+ docAuthors =
+ H.table ! HA.class_ "document-authors" $$
+ H.tbody $$ do
+ forM_ authors $ \a ->
+ H.tr $$
+ H.td ! HA.class_ "author" $$
+ html5ify a
+ header :: Html5 -> Html5
+ header h = H.tr ! HA.class_ "header" $$ h
+ headerName :: Html5 -> Html5
+ headerName h =
+ H.td ! HA.class_ "header-name" $$ do
+ h
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ Plain.l10n_Colon loc
+ headerValue :: Html5 -> Html5
+ headerValue h =
+ H.td ! HA.class_ "header-value" $$ do
+ h
+
+-- * Type 'Config'
+data Config
+ = forall locales.
+ ( Locales locales
+ , Loqualize locales (L10n Html5)
+ , Loqualize locales (Plain.L10n Plain.Plain)
+ ) =>
+ Config
+ { config_css :: Either FilePath TL.Text
+ , config_locale :: LocaleIn locales
+ , config_generator :: TL.Text
+ }
+instance Default Config where
+ def = Config
+ { config_css = Right "style/dtc-html5.css"
+ , config_locale = LocaleIn @'[EN] en_US
+ , config_generator = "https://hackage.haskell.org/package/hdoc"
+ }
-- * Type 'Html5'
type Html5 = StateMarkup State ()
+instance IsString Html5 where
+ fromString = html5ify
--- ** Type 'State'
+-- * Type 'State'
data State
= State
- { state_styles :: Map FilePath CSS
- , state_scripts :: Map FilePath Script
- , state_indexs :: Map DTC.Pos (DTC.Terms, Anchor.Irefs)
- , state_rrefs :: Anchor.Rrefs
- , state_figures :: Map Text (Map DTC.Pos DTC.Title)
- , state_references :: Map DTC.Ident DTC.About
- , state_plainify :: Plain.State
+ { state_styles :: Map FilePath TL.Text
+ , state_scripts :: Map FilePath TL.Text
+ , state_indexs :: Map DTC.Pos (Terms, Anchor.Irefs)
+ , state_rrefs :: Anchor.Rrefs
+ , state_figures :: Map TL.Text (Map DTC.Pos (Maybe Title))
+ , state_references :: Map Ident About
+ , state_notes :: Anchor.Notes
+ , state_plainify :: Plain.State
+ , state_l10n :: Loqualization (L10n Html5)
}
instance Default State where
def = State
- { state_styles = mempty
- , state_scripts = mempty
- , state_indexs = mempty
- , state_rrefs = mempty
- , state_figures = mempty
- , state_references = mempty
+ { state_styles = def
+ , state_scripts = def
+ , state_indexs = def
+ , state_rrefs = def
+ , state_figures = def
+ , state_references = def
+ , state_notes = def
, state_plainify = def
+ , state_l10n = Loqualization EN_US
}
-type CSS = Text
-type Script = Text
--- ** Type 'Keys'
+-- * Type 'Keys'
data Keys
= Keys
- { keys_index :: Map DTC.Pos DTC.Terms
- , keys_figure :: Map Text (Map DTC.Pos DTC.Title)
- , keys_reference :: Map DTC.Ident DTC.About
+ { keys_index :: Map DTC.Pos Terms
+ , keys_figure :: Map TL.Text (Map DTC.Pos (Maybe Title))
+ , keys_reference :: Map Ident About
} deriving (Show)
+instance Default Keys where
+ def = Keys mempty mempty mempty
-keys :: Trees DTC.BodyKey DTC.BodyValue -> Keys
-keys body = foldl' flt (Keys mempty mempty mempty) (Compose body)
- where
- flt acc = \case
- DTC.Index{..} -> acc{keys_index =
- Map.insert pos terms $ keys_index acc}
- DTC.Figure{..} -> acc{keys_figure =
- Map.insertWith (<>)
- type_ (Map.singleton pos title) $
- keys_figure acc}
- DTC.References{..} -> acc{keys_reference =
- foldr
- (\r -> Map.insert
- (DTC.id (r::DTC.Reference))
- (DTC.about (r::DTC.Reference)))
- (keys_reference acc)
- refs}
- _ -> acc
+-- ** Class 'KeysOf'
+class KeysOf a where
+ keys :: a -> S.State Keys ()
+instance KeysOf Body where
+ keys = mapM_ keys
+instance KeysOf (Tree BodyNode) where
+ keys (Tree n ts) =
+ case n of
+ BodySection{..} -> keys ts
+ BodyBlock b -> keys b
+instance KeysOf DTC.Block where
+ keys = \case
+ BlockPara{} -> return ()
+ BlockToC{} -> return ()
+ BlockToF{} -> return ()
+ BlockIndex{..} ->
+ S.modify $ \s -> s{keys_index=
+ Map.insert pos terms $ keys_index s}
+ BlockFigure{..} ->
+ S.modify $ \s -> s{keys_figure=
+ Map.insertWith (<>)
+ type_ (Map.singleton pos mayTitle) $
+ keys_figure s}
+ BlockReferences{..} ->
+ S.modify $ \s -> s{keys_reference=
+ foldr
+ (\r -> Map.insert
+ (DTC.id (r::DTC.Reference))
+ (DTC.about (r::DTC.Reference)))
+ (keys_reference s)
+ refs}
--- ** Class 'Html5ify'
+-- * Class 'Html5ify'
class Html5ify a where
html5ify :: a -> Html5
+instance Html5ify H.Markup where
+ html5ify = Compose . return
instance Html5ify Char where
html5ify = html5ify . H.toMarkup
instance Html5ify Text where
html5ify = html5ify . H.toMarkup
instance Html5ify String where
html5ify = html5ify . H.toMarkup
-instance Html5ify H.Markup where
- html5ify = Compose . return
-instance Html5ify DTC.Title where
- html5ify (DTC.Title t) = html5ify t
-instance Html5ify DTC.Para where
- html5ify = mapM_ html5ify
-instance Html5ify DTC.Ident where
- html5ify (DTC.Ident i) = html5ify i
+instance Html5ify Title where
+ html5ify (Title t) = html5ify t
+instance Html5ify Ident where
+ html5ify (Ident i) = html5ify i
instance Html5ify Int where
html5ify = html5ify . show
-instance Html5ify DTC.Nat where
- html5ify (DTC.Nat n) = html5ify n
-instance Html5ify DTC.Nat1 where
- html5ify (DTC.Nat1 n) = html5ify n
-
-html5Document ::
- Localize ls Plain Plain.L10n =>
- Locales ls =>
- LocaleIn ls -> DTC.Document -> Html
-html5Document locale DTC.Document{..} = do
- let Keys{..} = keys body
- let (body',state_rrefs,state_indexs) =
- let irefs = foldMap Anchor.irefsOfTerms keys_index in
- let (body0, Anchor.State{state_irefs, state_rrefs=rrefs}) =
- Anchor.anchorify body `S.runState`
- Anchor.state{Anchor.state_irefs=irefs} in
- (body0,rrefs,) $
- (<$> keys_index) $ \terms ->
- (terms,) $
- TreeMap.intersection const state_irefs $
- Anchor.irefsOfTerms terms
- let state_plainify = def
- { Plain.state_localize = Locale.localize locale }
- let (html5Body, State{state_styles,state_scripts}) =
- runStateMarkup def
- { state_indexs
- , state_rrefs
- , state_figures = keys_figure
- , state_references = keys_reference
- , state_plainify
- } $ html5ify body'
-
- H.docType
- H.html ! HA.lang (attrify $ countryCode locale) $ do
- H.head $ do
- H.meta ! HA.httpEquiv "Content-Type"
- ! HA.content "text/html; charset=UTF-8"
- whenSome (DTC.titles $ DTC.about (head :: DTC.Head)) $ \ts ->
- H.title $
- H.toMarkup $ Plain.text state_plainify $ List.head ts
- forM_ (DTC.links $ DTC.about (head :: DTC.Head)) $ \DTC.Link{rel, href} ->
- H.link ! HA.rel (attrify rel)
- ! HA.href (attrify href)
- H.meta ! HA.name "generator"
- ! HA.content "tct"
- let chapters =
- (`mapMaybe` toList body) $ \case
- TreeN k@DTC.Section{} _ -> Just k
- _ -> Nothing
- forM_ chapters $ \DTC.Section{..} ->
- H.link ! HA.rel "Chapter"
- ! HA.title (attrify $ plainify title)
- ! HA.href ("#"<>attrify pos)
- H.link ! HA.rel "stylesheet"
- ! HA.type_ "text/css"
- ! HA.href "style/dtc-html5.css"
- forM_ state_styles $ \style ->
- H.style ! HA.type_ "text/css" $
- H.toMarkup style
- forM_ state_scripts $ \script ->
- H.script ! HA.type_ "application/javascript" $
- H.toMarkup script
- H.body
- html5Body
+instance Html5ify Nat where
+ html5ify (Nat n) = html5ify n
+instance Html5ify Nat1 where
+ html5ify (Nat1 n) = html5ify n
+instance Html5ify a => Html5ify (Maybe a) where
+ html5ify = foldMap html5ify
-- * Type 'BodyCursor'
--- | Cursor to navigate within a 'DTC.Body' according to many axis (like in XSLT).
-type BodyCursor = Tree.Zipper DTC.BodyKey DTC.BodyValue
-instance Html5ify DTC.Body where
+-- | Cursor to navigate within a 'Body' according to many axis (like in XSLT).
+type BodyCursor = Tree.Zipper BodyNode
+instance Html5ify Body where
html5ify body =
forM_ (Tree.zippers body) $ \z ->
forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
html5ify
-
-instance Html5ify BodyCursor where
- html5ify z =
- case Tree.current z of
- TreeN k _ts -> html5BodyKey z k
- Tree0 v -> html5BodyValue z v
-
-html5BodyKey :: BodyCursor -> DTC.BodyKey -> Html5
-html5BodyKey z = \case
- DTC.Section{..} ->
+instance Html5ify BodyCursor
+ where html5ify z =
+ let Tree n _ts = Tree.current z in
+ case n of
+ BodyBlock BlockToC{..} -> do
+ H.nav ! HA.class_ "toc"
+ ! HA.id (attrify pos) $$ do
+ H.span ! HA.class_ "toc-name" $$
+ H.a ! HA.href (attrify pos) $$ do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ Plain.l10n_Table_of_Contents loc
+ H.ul $$
+ forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
+ html5ifyToC depth
+ BodyBlock b -> html5ify b
+ BodySection{..} -> do
+ do
+ notes <- liftStateMarkup $ S.gets state_notes
+ let mayNotes = do
+ p <- posParent $ posAncestors pos
+ let (ns, as) = Map.updateLookupWithKey (\_ _ -> Nothing) p notes
+ (,as) <$> ns
+ case mayNotes of
+ Nothing -> mempty
+ Just (secNotes, state_notes) -> do
+ liftStateMarkup $ S.modify' $ \s -> s{state_notes}
+ html5ify secNotes
H.section ! HA.class_ "section"
! HA.id (attrify pos) $$ do
- html5CommonAttrs attrs $
- H.table ! HA.class_ "section-header" $$
+ forM_ aliases html5ify
+ html5CommonAttrs attrs{classes="section-header":classes attrs} $
+ H.table $$
H.tbody $$
H.tr $$ do
H.td ! HA.class_ "section-number" $$ do
html5ify title
forM_ (Tree.axis_child `Tree.runAxis` z) $
html5ify
-html5BodyValue :: BodyCursor -> DTC.BodyValue -> Html5
-html5BodyValue z = \case
- DTC.Block b -> html5ify b
- DTC.ToC{..} -> do
- H.nav ! HA.class_ "toc"
- ! HA.id (attrify pos) $$ do
- H.span ! HA.class_ "toc-name" $$
- H.a ! HA.href (attrify pos) $$
- html5ify Plain.L10n_Table_of_Contents
- H.ul $$
- forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
- html5ifyToC depth
- DTC.ToF{..} -> do
+ notes <- liftStateMarkup $ S.gets state_notes
+ html5ify $ Map.lookup (posAncestors pos) notes
+instance Html5ify [Anchor.Note] where
+ html5ify notes =
+ H.aside ! HA.class_ "notes" $$ do
+ Compose $ pure H.hr
+ H.table $$
+ H.tbody $$
+ forM_ (List.reverse notes) $ \Anchor.Note{..} ->
+ H.tr $$ do
+ H.td ! HA.class_ "note-ref" $$ do
+ H.a ! HA.class_ "note-number"
+ ! HA.id ("note."<>attrify note_number)
+ ! HA.href ("#note."<>attrify note_number) $$ do
+ html5ify note_number
+ ". "::Html5
+ H.a ! HA.href ("#note-ref."<>attrify note_number) $$ do
+ "↑"
+ H.td $$
+ html5ify note_content
+instance Html5ify Block where
+ html5ify = \case
+ BlockPara para -> html5ify para
+ BlockToC{..} -> mempty -- NOTE: done in Html5ify BodyCursor
+ BlockToF{..} -> do
H.nav ! HA.class_ "tof"
! HA.id (attrify pos) $$
H.table ! HA.class_ "tof" $$
H.tbody $$
html5ifyToF types
- DTC.Figure{..} ->
- html5CommonAttrs attrs $
- H.div ! HA.class_ ("figure " <> attrify ("figure-"<>type_))
- ! HA.id (attrify pos) $$ do
+ BlockFigure{..} ->
+ html5CommonAttrs attrs
+ { classes = "figure":("figure-"<>type_):classes attrs
+ , DTC.id = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
+ } $
+ H.div $$ do
H.table ! HA.class_ "figure-caption" $$
H.tbody $$
H.tr $$ do
- H.td ! HA.class_ "figure-number" $$ do
- H.a ! HA.href ("#"<>attrify pos) $$ do
- html5ify type_
- html5ify $ DTC.posAncestors pos
- html5ify $ Plain.L10n_Colon
- H.td ! HA.class_ "figure-name" $$
- html5ify title
+ if TL.null type_
+ then H.a ! HA.href ("#"<>attrify pos) $$ mempty
+ else
+ H.td ! HA.class_ "figure-number" $$ do
+ H.a ! HA.href ("#"<>attrify (DTC.posAncestorsWithFigureNames pos)) $$ do
+ html5ify type_
+ html5ify $ DTC.posAncestorsWithFigureNames pos
+ forM_ mayTitle $ \title -> do
+ H.td ! HA.class_ "figure-colon" $$ do
+ unless (TL.null type_) $ do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ Plain.l10n_Colon loc
+ H.td ! HA.class_ "figure-title" $$ do
+ html5ify title
H.div ! HA.class_ "figure-content" $$ do
- html5ify blocks
- DTC.Index{pos} -> do
+ html5ify paras
+ BlockIndex{pos} -> do
(allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
let chars = Anchor.termsByChar allTerms
H.div ! HA.class_ "index"
H.dt $$
H.ul ! HA.class_ "index-aliases" $$
forM_ (List.take 1 aliases) $ \term ->
- H.li ! HA.id (attrify term) $$
+ H.li ! HA.id (attrifyIref term) $$
html5ify term
H.dd $$
let anchs =
html5CommasDot $
(<$> anchs) $ \(term,DTC.Anchor{..}) ->
H.a ! HA.class_ "index-iref"
- ! HA.href ("#"<>attrify (term,count)) $$
+ ! HA.href ("#"<>attrifyIrefCount term count) $$
html5ify $ DTC.posAncestors section
- DTC.References{..} ->
- html5CommonAttrs attrs $
- H.div ! HA.class_ "references"
- ! HA.id (attrify pos) $$ do
+ BlockReferences{..} ->
+ html5CommonAttrs attrs
+ { classes = "references":classes attrs
+ , DTC.id = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
+ } $
+ H.div $$ do
H.table $$
forM_ refs html5ify
-instance Html5ify DTC.Words where
- html5ify = html5ify . Anchor.plainifyWords
-
-cleanPara :: DTC.Para -> DTC.Para
-cleanPara p =
- p >>= (`Tree.bindTrees` \case
- TreeN DTC.Iref{} ls -> ls
- TreeN DTC.Note{} _ -> mempty
- h -> pure h)
-
html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
html5ifyToC depth z =
- case Tree.current z of
- TreeN DTC.Section{..} _ts -> do
+ let Tree n _ts = Tree.current z in
+ case n of
+ BodySection{..} -> do
H.li $$ do
H.table ! HA.class_ "toc-entry" $$
H.tbody $$
H.td ! HA.class_ "section-number" $$
html5SectionRef $ DTC.posAncestors pos
H.td ! HA.class_ "section-title" $$
- html5ify $ cleanPara $ DTC.unTitle title
- when (maybe True (> DTC.Nat 1) depth && not (null sections)) $
+ html5ify $ cleanPlain $ unTitle title
+ when (maybe True (> Nat 1) depth && not (null sections)) $
H.ul $$
forM_ sections $
- html5ifyToC (depth >>= DTC.predNat)
+ html5ifyToC (depth >>= predNat)
_ -> pure ()
where
sections =
(`Tree.runAxis` z) $
Tree.axis_child
`Tree.axis_filter_current` \case
- TreeN DTC.Section{} _ -> True
+ Tree BodySection{} _ -> True
_ -> False
-html5ifyToF :: [Text] -> Html5
+html5ifyToF :: [TL.Text] -> Html5
html5ifyToF types = do
figsByType <- liftStateMarkup $ S.gets state_figures
let figs =
H.a ! HA.href ("#"<>attrify pos) $$ do
html5ify type_
html5ify $ DTC.posAncestors pos
- H.td ! HA.class_ "figure-name" $$
- html5ify $ cleanPara $ DTC.unTitle title
+ forM_ title $ \ti ->
+ H.td ! HA.class_ "figure-title" $$
+ html5ify $ cleanPlain $ unTitle ti
-instance Html5ify [DTC.Block] where
- html5ify = mapM_ html5ify
-instance Html5ify DTC.Block where
+cleanPlain :: Plain -> Plain
+cleanPlain ps =
+ ps >>= \case
+ Tree PlainIref{} ls -> cleanPlain ls
+ Tree PlainNote{} _ -> mempty
+ Tree n ts -> pure $ Tree n $ cleanPlain ts
+
+instance Html5ify Para where
html5ify = \case
- DTC.Para{..} ->
- html5CommonAttrs attrs $
- H.p ! HA.class_ "para"
- ! HA.id (attrify pos) $$ do
- html5ify para
- DTC.OL{..} ->
- html5CommonAttrs attrs $
- H.ol ! HA.class_ "ol"
- ! HA.id (attrify pos) $$ do
+ ParaItem{..} ->
+ html5CommonAttrs def
+ { classes="para":cls item
+ } $
+ html5ify item
+ ParaItems{..} ->
+ html5CommonAttrs attrs
+ { classes = "para":classes attrs
+ , DTC.id = id_ pos
+ } $
+ H.div $$
forM_ items $ \item ->
- H.li $$ html5ify item
- DTC.UL{..} ->
- html5CommonAttrs attrs $
- H.ul ! HA.class_ "ul"
- ! HA.id (attrify pos) $$ do
- forM_ items $ \item ->
- H.li $$ html5ify item
- DTC.Comment t ->
- html5ify $ H.Comment (H.Text t) ()
-instance Html5ify DTC.Lines where
+ html5AttrClass (cls item) $
+ html5ify item
+ where
+ id_ = Just . Ident . Plain.text def . DTC.posAncestors
+ cls = \case
+ ParaPlain{} -> []
+ ParaArtwork{..} -> ["artwork", "artwork-"<>type_]
+ ParaQuote{..} -> ["quote", "quote-"<>type_]
+ ParaComment{} -> []
+ ParaOL{} -> ["ol"]
+ ParaUL{} -> ["ul"]
+instance Html5ify ParaItem where
html5ify = \case
- Tree0 v ->
- case v of
- DTC.BR -> html5ify H.br
- DTC.Plain t -> html5ify t
- TreeN k ls ->
- case k of
- DTC.B -> H.strong $$ html5ify ls
- DTC.Code -> H.code $$ html5ify ls
- DTC.Del -> H.del $$ html5ify ls
- DTC.I -> do
- i <- liftStateMarkup $ do
- i <- S.gets $ Plain.state_italic . state_plainify
- S.modify $ \s ->
- s{state_plainify=
- (state_plainify s){Plain.state_italic=
- not i}}
- return i
- H.em ! HA.class_ (if i then "even" else "odd") $$
- html5ify ls
- liftStateMarkup $
- S.modify $ \s ->
- s{state_plainify=
- (state_plainify s){Plain.state_italic=i}}
- DTC.Sub -> H.sub $$ html5ify ls
- DTC.Sup -> H.sup $$ html5ify ls
- DTC.SC -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
- DTC.U -> H.span ! HA.class_ "underline" $$ html5ify ls
- DTC.Note -> ""
- DTC.Q -> do
- d <- liftStateMarkup $ do
- d <- S.gets $ Plain.state_quote . state_plainify
- S.modify $ \s -> s{state_plainify=
- (state_plainify s){Plain.state_quote=
- DTC.succNat d}}
- return d
- H.span ! HA.class_ "q" $$ do
- html5ify $ Plain.L10n_QuoteOpen d
- html5ify $ TreeN DTC.I ls
- html5ify $ Plain.L10n_QuoteClose d
- liftStateMarkup $
- S.modify $ \s ->
- s{state_plainify=
- (state_plainify s){Plain.state_quote = d}}
- DTC.Eref{..} ->
- H.a ! HA.class_ "eref"
- ! HA.href (attrify href) $$
- if null ls
- then html5ify $ DTC.unURL href
- else html5ify ls
- DTC.Iref{..} ->
- case anchor of
- Nothing -> html5ify ls
- Just DTC.Anchor{..} ->
- H.span ! HA.class_ "iref"
- ! HA.id (attrify (term,count)) $$
- html5ify ls
- DTC.Ref{..} ->
- H.a ! HA.class_ "ref"
- ! HA.href ("#"<>attrify to) $$
+ ParaPlain p -> H.p $$ html5ify p
+ ParaArtwork{..} -> H.pre $$ do html5ify text
+ ParaQuote{..} -> H.div $$ do html5ify paras
+ ParaComment t -> html5ify $ H.Comment (H.String $ TL.unpack t) ()
+ ParaOL items ->
+ H.table $$ do
+ H.tbody $$
+ forM_ items $ \ListItem{..} -> do
+ H.tr $$ do
+ H.td ! HA.class_ "name" $$ do
+ html5ify name
+ "."::Html5
+ H.td ! HA.class_ "value" $$
+ html5ify paras
+ ParaUL items ->
+ H.dl $$ do
+ forM_ items $ \item -> do
+ H.dt $$ "—"
+ H.dd $$ html5ify item
+instance Html5ify [Para] where
+ html5ify = mapM_ html5ify
+
+instance Html5ify Plain where
+ html5ify ps =
+ case Seq.viewl ps of
+ Seq.EmptyL -> mempty
+ curr Seq.:< next ->
+ case curr of
+ -- NOTE: gather adjacent PlainNotes
+ Tree PlainNote{} _
+ | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
+ H.sup ! HA.class_ "note-numbers" $$ do
+ html5ify curr
+ forM_ notes $ \note -> do
+ ", "::Html5
+ html5ify note
+ " "::Html5
+ html5ify rest
+ --
+ _ -> do
+ html5ify curr
+ html5ify next
+instance Html5ify (Tree PlainNode)
+ where html5ify (Tree n ls) =
+ case n of
+ PlainBR -> html5ify H.br
+ PlainText t -> html5ify t
+ PlainGroup -> html5ify ls
+ PlainB -> H.strong $$ html5ify ls
+ PlainCode -> H.code $$ html5ify ls
+ PlainDel -> H.del $$ html5ify ls
+ PlainI -> do
+ i <- liftStateMarkup $ do
+ i <- S.gets $ Plain.state_italic . state_plainify
+ S.modify $ \s ->
+ s{state_plainify=
+ (state_plainify s){Plain.state_italic=
+ not i}}
+ return i
+ H.em ! HA.class_ (if i then "even" else "odd") $$
+ html5ify ls
+ liftStateMarkup $
+ S.modify $ \s ->
+ s{state_plainify=
+ (state_plainify s){Plain.state_italic=i}}
+ PlainSub -> H.sub $$ html5ify ls
+ PlainSup -> H.sup $$ html5ify ls
+ PlainSC -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
+ PlainU -> H.span ! HA.class_ "underline" $$ html5ify ls
+ PlainNote{..} ->
+ case number of
+ Nothing -> mempty
+ Just num ->
+ H.a ! HA.class_ "note-ref"
+ ! HA.id ("note-ref."<>attrify num)
+ ! HA.href ("#note."<>attrify num) $$
+ html5ify num
+ PlainQ -> do
+ H.span ! HA.class_ "q" $$ do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ Plain.l10n_Quote (html5ify $ Tree PlainI ls) loc
+ PlainEref{..} ->
+ H.a ! HA.class_ "eref"
+ ! HA.href (attrify href) $$
if null ls
- then html5ify to
+ then html5ify $ unURL href
else html5ify ls
- DTC.Rref{..} -> do
- refs <- liftStateMarkup $ S.gets state_references
- case Map.lookup to refs of
- Nothing -> do
- "["::Html5
- H.span ! HA.class_ "rref-broken" $$
- html5ify to
- "]"
- Just DTC.About{..} -> do
- when (not $ null ls) $
- forM_ (List.take 1 titles) $ \(DTC.Title title) -> do
- html5ify $ TreeN DTC.Q $
- case url of
- Nothing -> title
- Just u -> pure $ TreeN (DTC.Eref u) title
- " "::Html5
- "["::Html5
- H.a ! HA.class_ "rref"
- ! HA.href ("#rref."<>attrify to)
- ! HA.id ("rref."<>attrify to<>maybe "" (\DTC.Anchor{..} -> "."<>attrify count) anchor) $$
- html5ify to
- "]"
-instance Html5ify DTC.URL where
- html5ify (DTC.URL url) =
- H.a ! HA.class_ "eref"
- ! HA.href (attrify url) $$
- html5ify url
+ PlainIref{..} ->
+ case anchor of
+ Nothing -> html5ify ls
+ Just Anchor{..} ->
+ H.span ! HA.class_ "iref"
+ ! HA.id (attrifyIrefCount term count) $$
+ html5ify ls
+ PlainRef{..} ->
+ H.a ! HA.class_ "ref"
+ ! HA.href ("#"<>attrify to) $$
+ if null ls
+ then html5ify to
+ else html5ify ls
+ PlainRref{..} -> do
+ refs <- liftStateMarkup $ S.gets state_references
+ case Map.lookup to refs of
+ Nothing -> do
+ "["::Html5
+ H.span ! HA.class_ "rref-broken" $$
+ html5ify to
+ "]"
+ Just About{..} -> do
+ unless (null ls) $
+ forM_ (List.take 1 titles) $ \(Title title) -> do
+ html5ify $ Tree PlainQ $
+ case url of
+ Nothing -> title
+ Just u -> pure $ Tree (PlainEref u) title
+ " "::Html5
+ "["::Html5
+ H.a ! HA.class_ "rref"
+ ! HA.href ("#rref."<>attrify to)
+ ! HA.id ("rref."<>attrify to<>maybe "" (\Anchor{..} -> "."<>attrify count) anchor) $$
+ html5ify to
+ "]"
-instance Attrify DTC.Words where
- attrify term =
- "iref" <> "." <> attrify (Anchor.plainifyWords term)
-instance Attrify (DTC.Words,DTC.Nat1) where
- attrify (term,count) =
- "iref"
- <> "." <> attrify (Anchor.plainifyWords term)
- <> "." <> attrify count
-instance Html5ify DTC.Date where
- html5ify = html5ify . Plain.L10n_Date
-instance Html5ify DTC.About where
- html5ify DTC.About{..} =
+instance Html5ify [Title] where
+ html5ify =
+ html5ify . fold . List.intersperse sep . toList
+ where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
+instance Html5ify About where
+ html5ify About{..} =
html5CommasDot $ concat $
[ html5Titles titles
- , html5Entity <$> authors
- , html5ify <$> maybeToList date
- , html5Entity <$> maybeToList editor
- , html5Serie <$> series
+ , html5ify <$> authors
+ , html5ify <$> maybeToList date
+ , html5ify <$> maybeToList editor
+ , html5ify <$> series
]
where
- html5Titles :: [DTC.Title] -> [Html5]
+ html5Titles :: [Title] -> [Html5]
html5Titles ts | null ts = []
- html5Titles ts = [html5Title $ fold $ List.intersperse (DTC.Title " — ") $ toList ts]
- html5Title (DTC.Title title) =
- html5ify $ TreeN DTC.Q $
+ html5Titles ts = [html5Title $ joinTitles ts]
+ where
+ joinTitles = fold . List.intersperse sep . toList
+ sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
+ html5Title (Title title) =
+ html5ify $ Tree PlainQ $
case url of
Nothing -> title
- Just u -> pure $ TreeN (DTC.Eref u) title
- html5SerieHref href DTC.Serie{..} = do
- sp <- liftStateMarkup $ S.gets state_plainify
+ Just u -> pure $ Tree (PlainEref u) title
+instance Html5ify Serie where
+ html5ify s@Serie{id=id_, name} = do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ case urlSerie s of
+ Nothing -> do
+ html5ify name
+ Plain.l10n_Colon loc :: Html5
+ html5ify id_
+ Just href -> do
html5ify $
- TreeN DTC.Eref{href} $
+ Tree PlainEref{href} $
Seq.fromList
- [ Tree0 $ DTC.Plain $ name
- , Tree0 $ DTC.Plain $ TL.toStrict $ Plain.text sp Plain.L10n_Colon
- , Tree0 $ DTC.Plain key
+ [ tree0 $ PlainText $ name
+ , tree0 $ PlainText $ Plain.l10n_Colon loc
+ , tree0 $ PlainText id_
]
- html5Serie s@DTC.Serie{name="RFC", key} | Text.all Char.isDigit key =
- html5SerieHref (DTC.URL $ "https://tools.ietf.org/html/rfc"<>key) s
- html5Serie s@DTC.Serie{name="DOI", key} =
- html5SerieHref (DTC.URL $ "https://dx.doi.org/"<>key) s
- html5Serie DTC.Serie{..} = do
- html5ify name
- html5ify Plain.L10n_Colon
- html5ify key
- html5Entity DTC.Entity{url=mu, ..} = do
- html5ify @DTC.Lines $
- case () of
- _ | not (Text.null email) ->
- TreeN (DTC.Eref $ DTC.URL $ "mailto:"<>email) $
- pure $ Tree0 $ DTC.Plain name
- _ | Just u <- mu ->
- TreeN (DTC.Eref u) $
- pure $ Tree0 $ DTC.Plain name
- _ -> Tree0 $ DTC.Plain name
- forM_ org $ \o -> do
- " ("::Html5
- html5Entity o
- ")"::Html5
-instance Html5ify DTC.Reference where
- html5ify DTC.Reference{id=id_, ..} =
+instance Html5ify Entity where
+ html5ify Entity{..} = do
+ html5ify $
+ case () of
+ _ | not (TL.null email) ->
+ Tree (PlainEref $ URL $ "mailto:"<>email) $
+ pure $ tree0 $ PlainText name
+ _ | Just u <- url ->
+ Tree (PlainEref u) $
+ pure $ tree0 $ PlainText name
+ _ -> tree0 $ PlainText name
+ forM_ org $ \o -> do
+ " ("::Html5
+ html5ify o
+ ")"::Html5
+instance Html5ify Words where
+ html5ify = html5ify . Anchor.plainifyWords
+instance Html5ify Alias where
+ html5ify Alias{id=id_, ..} = do
+ H.a ! HA.class_ "alias"
+ ! HA.id (attrify id_) $$
+ mempty
+instance Html5ify URL where
+ html5ify (URL url) =
+ H.a ! HA.class_ "eref"
+ ! HA.href (attrify url) $$
+ html5ify url
+instance Html5ify Date where
+ html5ify date = do
+ Loqualization loc <- liftStateMarkup $ S.gets state_l10n
+ Plain.l10n_Date date loc
+instance Html5ify Reference where
+ html5ify Reference{id=id_, ..} =
H.tr $$ do
H.td ! HA.class_ "reference-key" $$
- html5ify @DTC.Lines $ TreeN DTC.Rref{anchor=Nothing, to=id_} Seq.empty
+ html5ify $ Tree PlainRref{anchor=Nothing, to=id_} Seq.empty
H.td ! HA.class_ "reference-content" $$ do
html5ify about
rrefs <- liftStateMarkup $ S.gets state_rrefs
Just anchs ->
H.span ! HA.class_ "reference-rrefs" $$
html5CommasDot $
- (<$> List.reverse anchs) $ \DTC.Anchor{..} ->
+ (<$> List.reverse anchs) $ \Anchor{..} ->
H.a ! HA.class_ "reference-rref"
! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
html5ify $ DTC.posAncestors section
+instance Html5ify PosPath where
+ html5ify ancs =
+ case toList ancs of
+ [(_n,c)] -> do
+ html5ify $ show c
+ html5ify '.'
+ as ->
+ html5ify $
+ Text.intercalate "." $
+ Text.pack . show . snd <$> as
+instance Html5ify Plain.Plain where
+ html5ify p = do
+ sp <- liftStateMarkup $ S.gets state_plainify
+ let (t,sp') = Plain.runPlain p sp
+ html5ify t
+ liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
html5CommasDot :: [Html5] -> Html5
html5CommasDot [] = pure ()
sequence_ $ List.intersperse ", " hs
"."
-html5CommonAttrs :: DTC.CommonAttrs -> Html5 -> Html5
-html5CommonAttrs DTC.CommonAttrs{id=id_, ..} =
- Compose . (addClass . addId <$>) . getCompose
- where
- addClass =
- case classes of
- [] -> id
- _ -> H.AddCustomAttribute "class" (H.Text $ Text.unwords classes)
- addId = maybe id (\(DTC.Ident i) ->
- H.AddCustomAttribute "id" (H.Text i)) id_
+html5AttrClass :: [TL.Text] -> Html5 -> Html5
+html5AttrClass = \case
+ [] -> Cat.id
+ cls ->
+ Compose .
+ (H.AddCustomAttribute "class"
+ (H.String $ TL.unpack $ TL.unwords cls) <$>) .
+ getCompose
+
+html5AttrId :: Ident -> Html5 -> Html5
+html5AttrId (Ident id_) =
+ Compose .
+ (H.AddCustomAttribute "id"
+ (H.String $ TL.unpack id_) <$>) .
+ getCompose
+
+html5CommonAttrs :: CommonAttrs -> Html5 -> Html5
+html5CommonAttrs CommonAttrs{id=id_, ..} =
+ html5AttrClass classes .
+ maybe Cat.id html5AttrId id_
-html5SectionNumber :: DTC.PosPath -> Html5
+html5SectionNumber :: PosPath -> Html5
html5SectionNumber = go mempty
where
- go :: DTC.PosPath -> DTC.PosPath -> Html5
+ go :: PosPath -> PosPath -> Html5
go prev next =
case Seq.viewl next of
Seq.EmptyL -> pure ()
html5ify '.'
go (prev Seq.|>a) as
-html5SectionRef :: DTC.PosPath -> Html5
+html5SectionRef :: PosPath -> Html5
html5SectionRef as =
H.a ! HA.href ("#"<>attrify as) $$
html5ify as
-instance Html5ify DTC.PosPath where
- html5ify ancs =
- case toList ancs of
- [(_n,c)] -> do
- html5ify $ show c
- html5ify '.'
- as ->
- html5ify $
- Text.intercalate "." $
- Text.pack . show . snd <$> as
-instance Html5ify Plain where
- html5ify p = do
- sp <- liftStateMarkup $ S.gets state_plainify
- let (t,sp') = Plain.runPlain p sp
- html5ify t
- liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
-instance Attrify Plain where
- attrify p =
- let (t,_) = Plain.runPlain p def in
- attrify t
-
-instance Attrify DTC.PosPath where
+-- * 'Attrify'
+instance Attrify Anchor where
+ attrify Anchor{..} = attrify section <> "." <> attrify count
+instance Attrify Plain.Plain where
+ attrify p = attrify t
+ where (t,_) = Plain.runPlain p def
+instance Attrify PosPath where
attrify = attrify . plainify
instance Attrify DTC.Pos where
attrify = attrify . DTC.posAncestors
--- * Type 'L10n'
-instance Html5ify Plain.L10n where
- html5ify = html5ify . plainify
-instance Localize ls Plain Plain.L10n => Localize ls Html5 Plain.L10n where
- localize loc a = html5ify (Locale.localize loc a::Plain)
-instance LocalizeIn FR Html5 Plain.L10n where
- localizeIn loc = html5ify @Plain . localizeIn loc
-instance LocalizeIn EN Html5 Plain.L10n where
- localizeIn loc = html5ify @Plain . localizeIn loc
+attrifyIref :: Words -> H.AttributeValue
+attrifyIref term =
+ "iref" <> "." <> attrify (Anchor.plainifyWords term)
+attrifyIrefCount :: Words -> Nat1 -> H.AttributeValue
+attrifyIrefCount term count =
+ "iref"
+ <> "." <> attrify (Anchor.plainifyWords term)
+ <> "." <> attrify count
+
+-- * Class 'L10n'
+class
+ ( Plain.L10n msg lang
+ , Plain.L10n TL.Text lang
+ ) => L10n msg lang where
+ l10n_Header_Address :: FullLocale lang -> msg
+ l10n_Header_Date :: FullLocale lang -> msg
+ l10n_Header_Version :: FullLocale lang -> msg
+ l10n_Header_Origin :: FullLocale lang -> msg
+ l10n_Header_Source :: FullLocale lang -> msg
+instance L10n Html5 EN where
+ l10n_Header_Address _loc = "Address"
+ l10n_Header_Date _loc = "Date"
+ l10n_Header_Origin _loc = "Origin"
+ l10n_Header_Source _loc = "Source"
+ l10n_Header_Version _loc = "Version"
+instance L10n Html5 FR where
+ l10n_Header_Address _loc = "Adresse"
+ l10n_Header_Date _loc = "Date"
+ l10n_Header_Origin _loc = "Origine"
+ l10n_Header_Source _loc = "Source"
+ l10n_Header_Version _loc = "Version"
+
+instance Plain.L10n Html5 EN where
+ l10n_Colon loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
+ l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
+ l10n_Date date loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
+ l10n_Quote msg _loc = do
+ depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
+ let (o,c) :: (Html5, Html5) =
+ case unNat depth `mod` 3 of
+ 0 -> ("“","”")
+ 1 -> ("« "," »")
+ _ -> ("‟","„")
+ o
+ setDepth $ succNat depth
+ msg
+ setDepth $ depth
+ c
+ where
+ setDepth d =
+ liftStateMarkup $ S.modify' $ \s ->
+ s{state_plainify=(state_plainify s){Plain.state_quote=d}}
+instance Plain.L10n Html5 FR where
+ l10n_Colon loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
+ l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
+ l10n_Date date loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
+ l10n_Quote msg _loc = do
+ depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
+ let (o,c) :: (Html5, Html5) =
+ case unNat depth `mod` 3 of
+ 0 -> ("« "," »")
+ 1 -> ("“","”")
+ _ -> ("‟","„")
+ o
+ setDepth $ succNat depth
+ msg
+ setDepth $ depth
+ c
+ where
+ setDepth d =
+ liftStateMarkup $ S.modify' $ \s ->
+ s{state_plainify=(state_plainify s){Plain.state_quote=d}}
sourcephile / git / doclang.git / blobdiff