exe/cli/Main.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE ExistentialQuantification #-}
   4 {-# LANGUAGE FlexibleContexts #-}
   5 {-# LANGUAGE OverloadedLists #-}
   6 {-# LANGUAGE OverloadedStrings #-}
   7 {-# LANGUAGE TupleSections #-}
   8 {-# LANGUAGE TypeApplications #-}
   9 {-# LANGUAGE TypeFamilies #-}
  10 {-# OPTIONS_GHC -fno-warn-orphans #-}
  11 module Main where
  12
  13 -- import Data.Reflection (reify, Reifies(..))
  14 -- import qualified Data.Text.IO as Text
  15 import Control.Applicative (pure)
  16 import Control.Monad (Monad(..), forM_, when)
  17 import Data.Bool
  18 import Data.Default.Class (Default(..))
  19 import Data.Either (Either(..))
  20 import Data.Eq (Eq(..))
  21 import Data.Foldable (Foldable(..))
  22 import Data.Function (($), (.))
  23 import Data.Functor ((<$>))
  24 import Data.Locale
  25 import Data.Maybe (Maybe(..), fromMaybe, maybe)
  26 import Data.Monoid (Monoid(..))
  27 import Data.Ord (Ord(..))
  28 import Data.Semigroup (Semigroup(..))
  29 import Data.String (String, IsString(..))
  30 import Data.Void (Void)
  31 import GHC.Exts (IsList(..))
  32 import Prelude (error)
  33 import System.FilePath as FilePath
  34 import System.IO (IO, FilePath)
  35 import Text.Show (Show(..))
  36 import qualified Data.ByteString as BS
  37 import qualified Data.Char as Char
  38 import qualified Data.List as List
  39 import qualified Data.Map.Strict as Map
  40 import qualified Data.Set as Set
  41 import qualified Data.Text as Text
  42 import qualified Data.Text.Lazy as TL
  43 import qualified Data.Text.Lazy.IO as TL
  44 import qualified Data.TreeSeq.Strict as Tree
  45 import qualified Data.Version as Version
  46 import qualified Paths_hdoc as Hdoc
  47 import qualified System.Directory as IO
  48 import qualified System.Environment as Env
  49 import qualified System.IO as IO
  50 import qualified Text.Blaze.Renderer.Utf8 as Blaze
  51 import qualified Text.Blaze.Utils as Blaze
  52 import qualified Text.Megaparsec as P
  53
  54 import qualified Hdoc.Utils           as FS
  55 import qualified Hdoc.TCT             as TCT
  56 import qualified Hdoc.TCT.Write.HTML5 as TCT
  57 import qualified Hdoc.TCT.Write.Plain as TCT
  58 import qualified Hdoc.TCT.Write.XML   as TCT
  59 import qualified Hdoc.DTC.Read.TCT    as DTC
  60 import qualified Hdoc.DTC.Sym         as DTC
  61 import qualified Hdoc.DTC.Write.HTML5 as DTC
  62 import qualified Hdoc.DTC.Write.XML   as DTC
  63 import qualified Hdoc.RNC.Write       as RNC
  64 import qualified Text.Blaze.DTC           as Blaze.DTC
  65 import qualified Text.Blaze.HTML5         as Blaze.HTML5
  66
  67 import Language.Symantic.CLI hiding (main)
  68 import qualified Language.Symantic.CLI as CLI
  69 import qualified Language.Symantic.Document.Term.IO as Doc
  70
  71 import qualified Language.Symantic.CLI.Plain as Plain
  72 import qualified Language.Symantic.CLI.Help  as Help
  73 import qualified Language.Symantic.CLI.Read  as Read
  74
  75 version :: TL.Text
  76 version = "hdoc-" <> TL.pack (Version.showVersion Hdoc.version)
  77
  78 main :: IO ()
  79 main = do
  80         lang <- getLang
  81         args <- Env.getArgs
  82         readArgs lang args >>= \case
  83          Nothing -> return ()
  84          Just (Left  err) -> onExit err
  85          Just (Right cmd) -> onCommand cmd
  86
  87 readArgs ::
  88  forall d.
  89  Plain.Doc d =>
  90  Lang -> [String] -> IO.IO (Maybe (Either (Exit (Doc d)) Command))
  91 readArgs lang args =
  92         case
  93                 Read.readArgs (cli (loqualize lang) lang) $
  94                 Read.Args $ Read.Arg <$> ("hdoc":args) of
  95          Right a -> return $ Just $ Right a
  96          Left err ->
  97                 case err of
  98                  P.FancyError pos es ->
  99                         case Set.toList es of
 100                          [P.ErrorCustom (Read.ErrorRead e)] ->
 101                                 case e of
 102                                  Exit_Error ee -> do
 103                                         IO.hPutStr IO.stderr $
 104                                                 P.parseErrorPretty @Read.Arg @(Read.ErrorRead Error) $
 105                                                 P.FancyError pos $ Set.singleton $ P.ErrorCustom $
 106                                                 Read.ErrorRead ee
 107                                         return Nothing
 108                                  _ -> return $ Just $ Left e
 109                          _ -> return Nothing
 110                  P.TrivialError pos e es -> do
 111                         IO.hPutStr IO.stderr $
 112                                 P.parseErrorPretty @_ @Void $
 113                                 P.TrivialError pos e es
 114                         return Nothing
 115
 116 -- * Type 'Exit'
 117 data Exit d
 118  =   Exit_Help d
 119  |   Exit_Version
 120  |   Exit_License (Loq d)
 121  |   Exit_Error Error
 122  deriving Show
 123 instance Show (Loqualization q) where
 124         show _ = "Loqualization"
 125
 126 onExit :: Exit (Doc Doc.TermIO) -> IO ()
 127 onExit (Exit_Help d) =
 128         Doc.runTermIO IO.stdout $
 129         Doc.withBreakable (Just 80) (runDoc d) <>
 130         Doc.newline
 131 onExit Exit_Version =
 132         TL.putStrLn version
 133 onExit (Exit_License (Loqualization l)) =
 134         Doc.runTermIO IO.stdout $
 135         runDoc $
 136         l10n_license l
 137 onExit Exit_Error{} =
 138         return ()
 139
 140 -- ** Type 'Error'
 141 data Error
 142  =   Error_Locale String
 143  deriving Show
 144
 145 -- * Type 'Command'
 146 data Command
 147  =   Command_Source  CommandSource
 148  |   Command_Compile CommandCompile
 149  |   Command_Schema  CommandSchema
 150  deriving (Show)
 151
 152 onCommand :: Command -> IO ()
 153 onCommand cmd@(Command_Source CommandSource{..}) = do
 154         IO.hPrint IO.stderr cmd
 155         TCT.readTCT source_input >>= \case
 156          Left err -> error $ show err
 157          Right tct -> do
 158                 when source_dump_tct $
 159                         FS.writeFile (source_output-<.>"tct.dump") $
 160                                 TL.pack $ Tree.prettyTrees tct
 161                 case source_format of
 162                  CommandSourceFormat_Plain ->
 163                         FS.writeFile source_output $
 164                         TCT.writePlain tct
 165                  CommandSourceFormat_HTML5 ->
 166                         FS.withFile source_output IO.WriteMode $ \h ->
 167                                 Blaze.renderMarkupToByteStringIO (BS.hPutStr h) $
 168                                 TCT.writeHTML5 tct
 169 onCommand cmd@(Command_Compile CommandCompile{..}) = do
 170         IO.hPrint IO.stderr cmd
 171         TCT.readTCT compile_input >>= \case
 172          Left err -> error $ show err
 173          Right tct -> do
 174                 when compile_dump_tct $ do
 175                         FS.writeFile (compile_output-<.>"tct.dump") $
 176                                 TL.pack $ Tree.prettyTrees tct
 177                 let xml = TCT.writeXML tct
 178                 when compile_dump_xml $ do
 179                         FS.writeFile (compile_output-<.>"xml.dump") $
 180                                 TL.pack $ Tree.prettyTrees xml
 181                 case DTC.readDTC xml of
 182                  Left err -> do
 183                         FS.removeFile $ compile_output-<.>"deps"
 184                         error $ P.parseErrorPretty err
 185                  Right dtc -> do
 186                         when compile_dump_deps $ do
 187                                 FS.writeFile (compile_output-<.>"deps") $
 188                                         writeDependencies compile_input tct
 189                         when compile_dump_xml $ do
 190                                 FS.writeFile (compile_output-<.>"dtc.dump") $
 191                                         TL.pack $ show dtc
 192                         case compile_format of
 193                          CommandCompileFormat_XML ->
 194                                 FS.withFile compile_output IO.WriteMode $ \h ->
 195                                         Blaze.prettyMarkupIO Blaze.DTC.isInlinedElement (BS.hPutStr h) $
 196                                         DTC.writeXML compile_locale dtc
 197                          CommandCompileFormat_HTML5{..} -> do
 198                                 config_css <- installFile compile_html5_output_css $ "style"</>"dtc-html5.css"
 199                                 config_js  <- installFile compile_html5_output_js  $ "style"</>"dtc-html5.js"
 200                                 let conf = DTC.Config
 201                                          { DTC.config_css
 202                                          , DTC.config_js
 203                                          , DTC.config_locale    = compile_locale
 204                                          , DTC.config_generator = version
 205                                          }
 206                                 FS.withFile compile_output IO.WriteMode $ \h -> do
 207                                         html <- DTC.writeHTML5 conf dtc
 208                                         Blaze.prettyMarkupIO
 209                                          Blaze.HTML5.isInlinedElement
 210                                          (BS.hPutStr h)
 211                                          html
 212                                 where
 213                                 installFile out name = do
 214                                         dataDir <- Hdoc.getDataDir
 215                                         let src = dataDir</>name
 216                                         case out of
 217                                          Nothing -> Right <$> FS.readFile src
 218                                          Just "" -> return $ Left ""
 219                                          Just dst -> do
 220                                                 IO.createDirectoryIfMissing True $ FilePath.takeDirectory dst
 221                                                 IO.copyFile src dst
 222                                                 return $ Left dst
 223 onCommand Command_Schema{} =
 224         forM_ DTC.schema $ \ru ->
 225                 TL.hPutStrLn IO.stdout $ RNC.renderWriter ru
 226
 227 writeDependencies :: FilePath -> TCT.Roots -> TL.Text
 228 writeDependencies input tct =
 229         let dir = FilePath.takeDirectory input in
 230         TL.pack input <> ":" <>
 231         foldMap
 232          ( TL.pack
 233          . ((" \\\n " <>)
 234          . FilePath.normalise
 235          . (dir </>)) )
 236          (TCT.dependencies tct) <>
 237         "\n"
 238
 239 -- ** Type 'CommandSource'
 240 data CommandSource
 241  =   CommandSource
 242  {   source_output    :: FilePath
 243  ,   source_dump_tct  :: Bool
 244  ,   source_format    :: CommandSourceFormat
 245  ,   source_input     :: FilePath
 246  }
 247  deriving (Show)
 248
 249 -- *** Type 'CommandSourceFormat'
 250 data CommandSourceFormat
 251  =   CommandSourceFormat_Plain
 252  |   CommandSourceFormat_HTML5
 253  deriving (Show)
 254 instance Default CommandSourceFormat where
 255         def = CommandSourceFormat_Plain
 256
 257 -- *** Type 'CommandSourceDump'
 258 data CommandSourceDump
 259  =   CommandSourceDump_TCT
 260  |   CommandSourceDump_XML
 261  deriving (Eq, Ord, Show)
 262
 263 -- ** Type 'CommandCompile'
 264 data CommandCompile
 265  =   CommandCompile
 266  {   compile_output    :: FilePath
 267  ,   compile_locale    :: Lang
 268  ,   compile_dump_tct  :: Bool
 269  ,   compile_dump_xml  :: Bool
 270  ,   compile_dump_deps :: Bool
 271  ,   compile_format    :: CommandCompileFormat
 272  ,   compile_input     :: FilePath
 273  -- ,   compile_dump     :: Set CommandCompileDump
 274  }
 275  deriving (Show)
 276
 277 -- *** Type 'CommandCompileFormat'
 278 data CommandCompileFormat
 279  =   CommandCompileFormat_HTML5
 280      { compile_html5_output_css :: Maybe FilePath
 281      , compile_html5_output_js  :: Maybe FilePath
 282      , compile_html5_dump_dtc   :: Bool
 283      }
 284  |   CommandCompileFormat_XML
 285      {
 286      }
 287  deriving (Show)
 288 instance Default CommandCompileFormat where
 289         def = CommandCompileFormat_HTML5
 290          { compile_html5_output_css = def
 291          , compile_html5_output_js  = def
 292          , compile_html5_dump_dtc   = False
 293          }
 294
 295 -- *** Type 'CommandCompileDump'
 296 data CommandCompileDump
 297  =   CommandCompileDump_TCT
 298  |   CommandCompileDump_XML
 299  |   CommandCompileDump_DTC
 300  |   CommandCompileDump_Deps
 301  deriving (Eq, Ord, Show)
 302
 303 -- ** Type 'CommandSchema'
 304 data CommandSchema
 305  =   CommandSchema
 306  deriving (Show)
 307
 308 -- * Class 'CLI'
 309 class
 310  ( Sym_Fun repr
 311  , Sym_App repr
 312  , Sym_Alt repr
 313  , Sym_AltApp repr
 314  , Sym_Help d repr
 315  , Sym_Rule repr
 316  , Sym_Interleaved repr
 317  , Sym_Command repr
 318  , Sym_Option repr
 319  , Sym_Exit repr
 320  , Plain.Doc d
 321  -- , Reifies lang
 322  ) => CLI d repr where
 323         cli :: Loq d -> Lang -> repr (Exit d) ArgCommand Command
 324         cli loq@(Loqualization l) lang =
 325                 help @d (l10n_cli l) $
 326                 CLI.main "hdoc" $ opts **> cmds
 327                 where
 328                 opts =
 329                         interleaved $
 330                         (\_ _ -> ())
 331                          <<$?   option_help loq (help_usage $ cli loq lang)
 332                          <<|?>> option_version loq
 333                          <<|?>> option_license loq
 334                 cmds =
 335                         Command_Source  <$$> command_source  loq <||>
 336                         Command_Compile <$$> command_compile loq lang <||>
 337                         Command_Schema  <$$> command_schema  loq
 338
 339         option_help :: Loq d -> d -> ((), repr (Exit d) ArgOption ())
 340         option_help (Loqualization l) d =
 341                 ((),) $
 342                 help @d (l10n_help_opt_help l) $
 343                 opt (OptionName 'h' "help") $
 344                 exit $ Exit_Help d
 345         option_version :: Loq d -> ((), repr (Exit d) ArgOption ())
 346         option_version (Loqualization l) = ((),) $
 347                 help @d (l10n_help_version l) $
 348                 long "version" $ exit $ Exit_Version
 349         option_license :: Loq d -> ((), repr (Exit d) ArgOption ())
 350         option_license loq@(Loqualization l) = ((),) $
 351                 help @d (l10n_help_license l) $
 352                 long "license" $ exit $ Exit_License loq
 353         option_input :: Loq d -> (FilePath, repr (Exit d) ArgOption FilePath)
 354         option_input (Loqualization l) =
 355                 (mempty,) $
 356                 help @d (l10n_help_opt_input l) $
 357                 opt (OptionName 'i' "input") $
 358                 string $ l10n_var_file l
 359         option_output :: Loq d -> (FilePath, repr (Exit d) ArgOption FilePath)
 360         option_output (Loqualization l) =
 361                 (mempty,) $
 362                 help @d (l10n_help_opt_output l) $
 363                 opt (OptionName 'o' "output") $
 364                 string $ l10n_var_file l
 365         option_lang :: Loq d -> Lang -> (Lang, repr (Exit d) ArgOption Lang)
 366         option_lang (Loqualization l) lang =
 367                 (lang,) $
 368                 help @d (l10n_help_opt_lang l) $
 369                 long "lang" $
 370                 var (l10n_var_locale l) $ \s ->
 371                         maybe (Left $ Exit_Error $ Error_Locale s) Right $
 372                         Map.lookup (Text.pack s) $
 373                         locales @Langs
 374         option_dump_tct :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 375         option_dump_tct (Loqualization l) =
 376                 help @d (l10n_help_opt_dump_tct l) <$>
 377                 flag (OptionNameLong "dump-tct")
 378         option_dump_xml :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 379         option_dump_xml (Loqualization l) =
 380                 help @d (l10n_help_opt_dump_xml l) <$>
 381                 flag (OptionNameLong "dump-xml")
 382         option_dump_deps :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 383         option_dump_deps (Loqualization l) =
 384                 help @d (l10n_help_opt_dump_deps l) <$>
 385                 flag (OptionNameLong "dump-deps")
 386         option_dump_dtc :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 387         option_dump_dtc (Loqualization l) =
 388                 help @d (l10n_help_opt_dump_dtc l) <$>
 389                 flag (OptionNameLong "dump-dtc")
 390
 391         command_source :: Loq d -> repr (Exit d) ArgCommand CommandSource
 392         command_source loq@(Loqualization l) =
 393                 help @d (l10n_help_command_source l) $
 394                 command "source" $
 395                 (interleaved $
 396                         CommandSource
 397                          <<$?   option_help loq (help_usage $ command_source loq)
 398                          <<|?>> option_output   loq
 399                          <<|?>> option_dump_tct loq)
 400                  <**> (command_source_plain loq
 401                   <||> command_source_html5 loq)
 402                  <**> string (l10n_var_file l)
 403         command_source_plain :: Loq d -> repr (Exit d) ArgCommand CommandSourceFormat
 404         command_source_plain loq@(Loqualization l) =
 405                 help @d (l10n_help_format_plain l) $
 406                 command "plain" $
 407                 interleaved $
 408                 CommandSourceFormat_Plain
 409                  <<$?   option_help loq (help_usage $ command_source_plain loq)
 410         command_source_html5 :: Loq d -> repr (Exit d) ArgCommand CommandSourceFormat
 411         command_source_html5 loq@(Loqualization l) =
 412                 help @d (l10n_help_format_html5 l) $
 413                 command "html" $
 414                 interleaved $
 415                 CommandSourceFormat_HTML5
 416                  <<$?   option_help loq (help_usage $ command_source_html5 loq)
 417
 418         command_compile :: Loq d -> Lang -> repr (Exit d) ArgCommand CommandCompile
 419         command_compile loq@(Loqualization l) lang =
 420                 help @d (l10n_help_command_compile l) $
 421                 command "compile" $
 422                 (setDefault <$$>) $
 423                 (interleaved $
 424                         CommandCompile
 425                          <<$?   option_help loq (help_usage $ command_compile loq lang)
 426                          <<|?>> option_output    loq
 427                          <<|?>> option_lang      loq lang
 428                          <<|?>> option_dump_tct  loq
 429                          <<|?>> option_dump_xml  loq
 430                          <<|?>> option_dump_deps loq)
 431                  <**> (command_compile_html5 loq
 432                   <||> command_compile_xml   loq)
 433                  <**> string (l10n_var_file l)
 434                 where
 435                 setDefault a@CommandCompile{..}
 436                  | null compile_output = (a::CommandCompile){compile_output=compile_input-<.>fmt compile_format}
 437                  | otherwise = a
 438                 fmt = \case
 439                  CommandCompileFormat_XML{}   -> "xml"
 440                  CommandCompileFormat_HTML5{} -> "html"
 441         command_compile_html5 :: Loq d -> repr (Exit d) ArgCommand CommandCompileFormat
 442         command_compile_html5 loq@(Loqualization l) =
 443                 help @d (l10n_help_format_html5 l) $
 444                 command "html" $
 445                 interleaved $
 446                         CommandCompileFormat_HTML5
 447                          <<$?   option_help loq (help_usage $ command_compile_html5 loq)
 448                          <<|?>> option_html5_output_css
 449                          <<|?>> option_html5_output_js
 450                          <<|?>> option_dump_dtc loq
 451                 where
 452                 option_html5_output_css =
 453                         (Nothing,) $
 454                         (Just <$$>) $
 455                         help @d (l10n_help_opt_output_css l) $
 456                         opt (OptionNameLong "output-css") $
 457                         string $ l10n_var_file l
 458                 option_html5_output_js =
 459                         (Nothing,) $
 460                         (Just <$$>) $
 461                         help @d (l10n_help_opt_output_js l) $
 462                         opt (OptionNameLong "output-js") $
 463                         string $ l10n_var_file l
 464         command_compile_xml :: Loq d -> repr (Exit d) ArgCommand CommandCompileFormat
 465         command_compile_xml loq@(Loqualization l) =
 466                 help @d (l10n_help_format_xml l) $
 467                 command "xml" $
 468                 interleaved $
 469                 CommandCompileFormat_XML
 470                  <<$?   option_help loq (help_usage $ command_compile_xml loq)
 471
 472         command_schema :: Loq d -> repr (Exit d) ArgCommand CommandSchema
 473         command_schema loq@(Loqualization l) =
 474                 help @d (l10n_help_command_schema l) $
 475                 command "schema" $
 476                 interleaved $
 477                 CommandSchema
 478                  <<$? option_help loq (help_usage $ command_schema loq)
 479 instance Plain.Doc d => CLI d (Plain.Plain d)
 480 instance Plain.Doc d => CLI d Read.Parser
 481 instance Plain.Doc d => CLI d (Help.Help d)
 482
 483 help_usage :: Plain.Doc d => Help.Help d (Exit d) t a -> d
 484 help_usage = Help.textHelp Help.defReader
 485  { Help.reader_command_indent = 2
 486  , Help.reader_option_indent  = 12
 487  }
 488
 489 -- * Type 'Lang'
 490 -- | Supported locales
 491 type Langs = '[FR, EN]
 492 type Lang  = LocaleIn Langs
 493
 494 getLang :: IO Lang
 495 getLang =
 496         (\v -> Map.findWithDefault
 497          (LocaleIn @Langs en_US)
 498          (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
 499          (locales @Langs)) .
 500         fromMaybe ""
 501          <$> Env.lookupEnv "LANG"
 502
 503 -- ** Class 'L10n'
 504 type Loq d = Loqualization (L10n d)
 505 -- | Localization
 506 class L10n_Var lang => L10n d lang where
 507         l10n_cli                  :: FullLocale lang -> d
 508         l10n_license              :: FullLocale lang -> d
 509         l10n_help_version         :: FullLocale lang -> d
 510         l10n_help_license         :: FullLocale lang -> d
 511         l10n_help_command_source  :: FullLocale lang -> d
 512         l10n_help_command_compile :: FullLocale lang -> d
 513         l10n_help_command_schema  :: FullLocale lang -> d
 514         l10n_help_opt_lang        :: FullLocale lang -> d
 515         l10n_help_opt_output      :: FullLocale lang -> d
 516         l10n_help_opt_output_css  :: FullLocale lang -> d
 517         l10n_help_opt_output_js   :: FullLocale lang -> d
 518         l10n_help_opt_dump_tct    :: FullLocale lang -> d
 519         l10n_help_opt_dump_xml    :: FullLocale lang -> d
 520         l10n_help_opt_dump_deps   :: FullLocale lang -> d
 521         l10n_help_opt_dump_dtc    :: FullLocale lang -> d
 522         l10n_help_format          :: FullLocale lang -> d
 523         l10n_help_format_plain    :: FullLocale lang -> d
 524         l10n_help_format_html5    :: FullLocale lang -> d
 525         l10n_help_format_xml      :: FullLocale lang -> d
 526         l10n_help_opt_input       :: FullLocale lang -> d
 527         l10n_help_opt_help        :: FullLocale lang -> d
 528 class L10n_Var lang where
 529         l10n_var_file   :: FullLocale lang -> Name
 530         l10n_var_locale :: FullLocale lang -> Name
 531
 532 -- * Type 'Doc'
 533 data Doc d
 534  =   Doc d
 535  |   Var Name
 536  deriving Show
 537 instance (Semigroup d, IsString d) => Semigroup (Doc d) where
 538         Doc x <> Doc y = Doc (x<>y)
 539         x <> y = Doc $ runDoc x <> runDoc y
 540 instance (Semigroup d, Monoid d, IsString d) => Monoid (Doc d) where
 541         mempty  = Doc mempty
 542         mappend = (<>)
 543 instance Doc.Breakable d => IsString (Doc d) where
 544         fromString = Doc . Plain.words
 545 instance (IsString d, Semigroup d, Monoid d) => IsList (Doc d) where
 546         type Item (Doc d) = Doc d
 547         toList = pure
 548         fromList = Doc . foldMap runDoc
 549 instance (IsString d, Semigroup d) => Doc.Trans (Doc d) where
 550         type ReprOf (Doc d) = d
 551         trans   = Doc
 552         unTrans = runDoc
 553 instance Doc.Breakable d => Doc.Textable (Doc d)
 554 instance (Doc.Breakable d, Doc.Indentable d) => Doc.Indentable (Doc d)
 555 instance Doc.Breakable d => Doc.Breakable (Doc d)
 556 instance (IsString d, Semigroup d, Doc.Decorable d) => Doc.Decorable (Doc d)
 557 instance (IsString d, Semigroup d, Doc.Colorable d) => Doc.Colorable (Doc d)
 558 instance Plain.Doc d => Plain.Doc (Doc d)
 559
 560 runDoc :: (IsString d, Semigroup d) => Doc d -> d
 561 runDoc = \case
 562  Doc d -> d
 563  Var n -> "<"<>fromString n<>">"
 564
 565 instance (IsString d, Semigroup d, Monoid d, Doc.Breakable d) => L10n (Doc d) EN where
 566         l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
 567         l10n_license _ =
 568                 fromString $
 569                 List.intercalate "\n"
 570                  [ "License: GNU GPLv3+"
 571                  , "Copyright: Julien Moutinho <julm+hdoc@autogeree.net>"
 572                  , ""
 573                  , "hdoc is free software: you can redistribute it and/or modify it"
 574                  , "under the terms of the GNU General Public License (GPL)"
 575                  , "as published by the Free Software Foundation;"
 576                  , "either in version 3, or (at your option) any later version."
 577                  , ""
 578                  , "hdoc is distributed in the hope that it will be useful,"
 579                  , "but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY"
 580                  , "or FITNESS FOR A PARTICULAR PURPOSE."
 581                  , ""
 582                  , "See the GNU GPL for more details."
 583                  , "You should have received a copy of the GNU GPL along with hdoc."
 584                  , "If not, see: http://www.gnu.org/licenses/"
 585                  ]
 586         l10n_help_version         _ = "Show the version of this program."
 587         l10n_help_license         _ = "Inform about the license of this program."
 588         l10n_help_command_source  _ = "Format the source code of a TCT document."
 589         l10n_help_command_compile _ = "Compile a TCT document into a format optimized for reading."
 590         l10n_help_command_schema  _ = "Show in RNC (RelaxNG Compact) format the XML schema of the DTC format."
 591         l10n_help_opt_lang        l = ["Use the language given by ", Var $ l10n_var_locale l, "."]
 592         l10n_help_opt_output      l = ["Output document into ", Var $ l10n_var_file l]
 593         l10n_help_opt_output_css  l = [ "Output CSS stylesheet into "
 594                                       , Var $ l10n_var_file l
 595                                       , " (if any), instead of incorporating it into the HTML."
 596                                       ]
 597         l10n_help_opt_output_js   l = [ "Output JavaScript script into "
 598                                       , Var $ l10n_var_file l
 599                                       , " (if any), instead of incorporating it into the HTML."
 600                                       ]
 601         l10n_help_opt_dump_tct    _ = "Dump internal representation of TCT."
 602         l10n_help_opt_dump_xml    _ = "Dump internal representation of XML."
 603         l10n_help_opt_dump_deps   _ = "Dump dependencies, in Makefile format."
 604         l10n_help_opt_dump_dtc    _ = "Dump internal representation of DTC."
 605         l10n_help_opt_help        _ = "Show this help."
 606         l10n_help_format          _ = "Output format."
 607         l10n_help_format_plain    _ = "Output as plain text."
 608         l10n_help_format_html5    _ = "Output as HTML5."
 609         l10n_help_format_xml      _ = "Output as XML."
 610         l10n_help_opt_input       l = ["Read input from ", Var $ l10n_var_file l, "."]
 611 instance (IsString d , Semigroup d, Monoid d, Doc.Breakable d) => L10n (Doc d) FR where
 612         l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
 613         l10n_license _ =
 614                 fromString $
 615                 List.intercalate "\n"
 616                  [ "Licence : GPLv3+ GNU"
 617                  , "Droit d’auteur : Julien Moutinho <julm+hdoc@autogeree.net>"
 618                  , ""
 619                  , "hdoc est un logiciel libre : vous pouvez le redistribuer et/ou le modifier"
 620                  , "selon les termes de la Licence Publique Générale (GPL) GNU"
 621                  , "telle que publiée par la Free Software Foundation ;"
 622                  , "en version 3, ou (à votre choix) n’importe quelle version ultérieure."
 623                  , ""
 624                  , "hdoc est distribué dans l’espoir qu’il sera utile,"
 625                  , "mais SANS AUCUNE GARANTIE ; sans même la garantie implicite de COMMERCIALISATION"
 626                  , "ou de CONVENANCE À UN BUT PARTICULIER."
 627                  , ""
 628                  , "Voyez la GPL pour davantage de détails."
 629                  , "Vous devriez avoir reçu une copie de la GPL avec hdoc."
 630                  , "Si non, voyez : http://www.gnu.org/licenses/"
 631                  ]
 632         l10n_help_version         _ = "Affiche la version de ce logiciel."
 633         l10n_help_license         _ = "Informe sur la licence de ce logiciel."
 634         l10n_help_command_source  _ = "Lit un document TCT et écrit un rendu préservant sa syntaxe."
 635         l10n_help_command_compile _ = "Compile un document TCT vers un format optimisé pour la lecture."
 636         l10n_help_command_schema  _ = "Affiche au format RNC (RelaxNG Compact) le schéma XML du format DTC."
 637         l10n_help_opt_lang        l = ["Utilise le langage indiqué par ", Var $ l10n_var_locale l, "."]
 638         l10n_help_opt_output      l = ["Écrit dans ", Var $ l10n_var_file l, "."]
 639         l10n_help_opt_output_css  l = [ "Écrit la feuille de style CSS dans "
 640                                       , Var $ l10n_var_file l
 641                                       , ", au lieu de l’incorporer dans le HTML."
 642                                       ]
 643         l10n_help_opt_output_js   l = [ "Écrit le script JavaScript dans "
 644                                       , Var $ l10n_var_file l
 645                                       , ", au lieu de l’incorporer dans le HTML."
 646                                       ]
 647         l10n_help_opt_dump_tct    _ = "Écrit la représentation interne du TCT."
 648         l10n_help_opt_dump_xml    _ = "Écrit la représentation interne du XML."
 649         l10n_help_opt_dump_deps   _ = "Écrit les dépendences, au format Makefile."
 650         l10n_help_opt_dump_dtc    _ = "Écrit la représentation interne du DTC."
 651         l10n_help_opt_help        _ = "Affiche cette aide."
 652         l10n_help_format          _ = "Format de sortie."
 653         l10n_help_format_plain    _ = "Produit du texte brut."
 654         l10n_help_format_html5    _ = "Produit du HTML5."
 655         l10n_help_format_xml      _ = "Produit du XML."
 656         l10n_help_opt_input       l = ["Lit depuis ", Var $ l10n_var_file l, "."]
 657 instance L10n_Var EN where
 658         l10n_var_file   _ = "file"
 659         l10n_var_locale _ = "locale"
 660 instance L10n_Var FR where
 661         l10n_var_file   _ = "fichier"
 662         l10n_var_locale _ = "locale"