import Data.Bool
import Data.Char (Char)
import Data.Default.Class (Default(..))
-import Data.Foldable (Foldable(..), concat)
+import Data.Eq (Eq(..))
+import Data.Foldable (Foldable(..), concat, any)
import Data.Function (($), const, flip, on)
import Data.Functor (Functor(..), (<$>))
import Data.Functor.Compose (Compose(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
-import Data.Traversable (Traversable(..))
import Data.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (snd)
-import Prelude (undefined)
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.Locale as Locale
import Language.DTC.Document as DTC
-import Language.DTC.Utils
import Language.DTC.Write.Plain (Plainify(..))
import Language.DTC.Write.XML ()
import qualified Language.DTC.Anchor as Anchor
Locales locales =>
LocaleIn locales -> DTC.Document -> Html
document locale DTC.Document{..} = do
- let titles = DTC.titles $ DTC.about (head :: Head)
let Keys{..} = keys body `S.execState` def
let (body',state_rrefs,state_notes,state_indexs) =
let irefs = foldMap Anchor.irefsOfTerms keys_index in
Anchor.irefsOfTerms terms
let state_plainify = def
{ Plain.state_localize = Locale.localize locale }
- let (html5Body, State{state_styles,state_scripts}) =
+ let (html5Body, endState) =
runStateMarkup def
{ state_indexs
, state_rrefs
, state_plainify
, state_localize = Locale.localize locale
} $ do
- html5Head head
- unless (null titles) $
- H.div ! HA.class_ "title" $$ do
- forM_ titles $ \title ->
- H.h1 $$ html5ify title
+ html5DocumentHead head
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"
- unless (null titles) $ do
- H.title $
- H.toMarkup $ Plain.text state_plainify $ List.head titles
- forM_ (DTC.links $ DTC.about (head :: Head)) $ \Link{rel, href} ->
- H.link ! HA.rel (attrify rel)
- ! HA.href (attrify href)
- H.meta ! HA.name "generator"
- ! HA.content "https://hackage.haskell.org/package/hdoc"
- 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
+ html5Head endState head body
+ H.body $ html5Body
+
+html5Head :: State -> Head -> Body -> Html
+html5Head 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)
+ H.meta ! HA.name "generator"
+ ! HA.content "https://hackage.haskell.org/package/hdoc"
+ 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
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
+ unless (any (\DTC.Link{rel} -> rel == "script") links) $ do
forM_ state_scripts $ \script ->
H.script ! HA.type_ "application/javascript" $
H.toMarkup script
- H.body $
- html5Body
-html5Head :: Head -> Html5
-html5Head Head{DTC.about=About{..}} = do
+html5DocumentHead :: Head -> Html5
+html5DocumentHead Head{DTC.about=About{..}} = do
H.div ! HA.class_ "document-head" $$
H.table $$ do
- H.tbody $$
+ H.tbody $$ do
H.tr $$ do
H.td ! HA.class_ "left" $$ docHeaders
H.td ! HA.class_ "right" $$ docAuthors
- case url of
- Nothing -> mempty
- Just href ->
- H.td ! HA.class_ "full" $$
- html5ify $ tree0 $ PlainEref{href}
+ unless (null titles) $
+ H.div ! HA.class_ "title" $$ do
+ forM_ titles $ \title ->
+ H.h1 $$ html5ify title
where
docHeaders =
H.table ! HA.class_ "document-headers" $$
headerValue $
H.a ! HA.href (attrify href) $$
html5ify id_
- forM_ version $ \v ->
- header $ do
- headerName $ html5ify L10n_Header_Version
- headerValue $ html5ify v
forM_ date $ \d ->
header $ do
headerName $ html5ify L10n_Header_Date
headerValue $ html5ify d
+ forM_ url $ \href ->
+ header $ do
+ headerName $ html5ify L10n_Header_Address
+ 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 $
- H.a ! HA.href (attrify href) $$
- html5ify plain
+ headerValue $ html5ify value
docAuthors =
H.table ! HA.class_ "document-authors" $$
H.tbody $$ do
H.td ! HA.class_ "header-value" $$ do
h
-{-
- , titles :: [Title]
- , url :: Maybe URL
- , authors :: [Entity]
- , editor :: Maybe Entity
- , date :: Maybe Date
- , version :: MayText
- , keywords :: [TL.Text]
- , links :: [Link]
- , series :: [Serie]
- , includes :: [Include]
--}
-
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip (<$>)
infixl 4 <&>
-- * Type 'L10n'
data L10n
- = L10n_Header_Date
+ = L10n_Header_Address
+ | L10n_Header_Date
| L10n_Header_Version
+ | L10n_Header_Origin
+ | L10n_Header_Source
deriving (Show)
instance Html5ify L10n where
html5ify msg = do
loc msg
instance LocalizeIn EN Html5 L10n where
localizeIn _ = \case
+ L10n_Header_Address -> "Address"
L10n_Header_Date -> "Date"
+ L10n_Header_Origin -> "Origin"
+ L10n_Header_Source -> "Source"
L10n_Header_Version -> "Version"
instance LocalizeIn FR Html5 L10n where
localizeIn _ = \case
+ L10n_Header_Address -> "Adresse"
L10n_Header_Date -> "Date"
+ L10n_Header_Origin -> "Origine"
+ L10n_Header_Source -> "Source"
L10n_Header_Version -> "Version"
instance Html5ify Plain.L10n where
sourcephile / git / doclang.git / blobdiff