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(..), 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 Language.Symantic.RNC.Write as RNC
  47 import qualified Paths_hdoc as Hdoc
  48 import qualified System.Directory as IO
  49 import qualified System.Environment as Env
  50 import qualified System.IO as IO
  51 import qualified Text.Blaze.Renderer.Utf8 as Blaze
  52 import qualified Text.Blaze.Utils as Blaze
  53 import qualified Text.Megaparsec as P
  54
  55 import qualified Hdoc.Utils           as FS
  56 import qualified Hdoc.TCT             as TCT
  57 import qualified Hdoc.TCT.Write.HTML5 as TCT
  58 import qualified Hdoc.TCT.Write.Plain as TCT
  59 import qualified Hdoc.TCT.Write.XML   as TCT
  60 import qualified Hdoc.DTC.Read.TCT    as DTC
  61 import qualified Hdoc.DTC.Sym         as DTC
  62 import qualified Hdoc.DTC.Write.HTML5 as DTC
  63 import qualified Hdoc.DTC.Write.XML   as DTC
  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 newtype 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 cmdComp@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                                 writeDependencies cmdComp tct
 188                         when compile_dump_xml $ do
 189                                 FS.writeFile (compile_output-<.>"dtc.dump") $
 190                                         TL.pack $ show dtc
 191                         case compile_format of
 192                          CommandCompileFormat_XML ->
 193                                 FS.withFile compile_output IO.WriteMode $ \h ->
 194                                         Blaze.prettyMarkupIO Blaze.DTC.isInlinedElement (BS.hPutStr h) $
 195                                         DTC.writeXML compile_locale dtc
 196                          CommandCompileFormat_HTML5{..} -> do
 197                                 config_css <- installFile compile_html5_output_css $ "style"</>"dtc-html5.css"
 198                                 config_js  <- installFile compile_html5_output_js  $ "style"</>"dtc-html5.js"
 199                                 let conf = DTC.Config
 200                                          { DTC.config_css
 201                                          , DTC.config_js
 202                                          , DTC.config_locale    = compile_locale
 203                                          , DTC.config_generator = version
 204                                          }
 205                                 FS.withFile compile_output IO.WriteMode $ \h -> do
 206                                         html <- DTC.writeHTML5 conf dtc
 207                                         Blaze.prettyMarkupIO
 208                                          Blaze.HTML5.isInlinedElement
 209                                          (BS.hPutStr h)
 210                                          html
 211                                 where
 212                                 installFile out name = do
 213                                         dataDir <- Hdoc.getDataDir
 214                                         let src = dataDir</>name
 215                                         case out of
 216                                          Nothing -> Right <$> FS.readFile src
 217                                          Just "" -> return $ Left ""
 218                                          Just dst -> do
 219                                                 IO.createDirectoryIfMissing True $ FilePath.takeDirectory dst
 220                                                 IO.copyFile src dst
 221                                                 return $ Left dst
 222 onCommand Command_Schema{} =
 223         TL.hPutStrLn IO.stdout $
 224                 RNC.writeRNC DTC.schema DTC.schema
 225
 226 writeDependencies :: CommandCompile -> TCT.Roots -> IO ()
 227 writeDependencies CommandCompile{..} tct =
 228         let dir = FilePath.takeDirectory compile_input in
 229         FS.writeFile (compile_input-<.>"deps") $
 230                 foldMap (TL.pack . (("\n" <>) . FilePath.normalise))
 231                  ((dir </>) <$> TCT.dependencies tct) <>
 232                 "\n"
 233
 234 -- ** Type 'CommandSource'
 235 data CommandSource
 236  =   CommandSource
 237  {   source_output    :: FilePath
 238  ,   source_dump_tct  :: Bool
 239  ,   source_format    :: CommandSourceFormat
 240  ,   source_input     :: FilePath
 241  }
 242  deriving (Show)
 243
 244 -- *** Type 'CommandSourceFormat'
 245 data CommandSourceFormat
 246  =   CommandSourceFormat_Plain
 247  |   CommandSourceFormat_HTML5
 248  deriving (Show)
 249 instance Default CommandSourceFormat where
 250         def = CommandSourceFormat_Plain
 251
 252 -- *** Type 'CommandSourceDump'
 253 data CommandSourceDump
 254  =   CommandSourceDump_TCT
 255  |   CommandSourceDump_XML
 256  deriving (Eq, Ord, Show)
 257
 258 -- ** Type 'CommandCompile'
 259 data CommandCompile
 260  =   CommandCompile
 261  {   compile_output    :: FilePath
 262  ,   compile_locale    :: Lang
 263  ,   compile_dump_tct  :: Bool
 264  ,   compile_dump_xml  :: Bool
 265  ,   compile_dump_deps :: Bool
 266  ,   compile_format    :: CommandCompileFormat
 267  ,   compile_input     :: FilePath
 268  -- ,   compile_dump     :: Set CommandCompileDump
 269  }
 270  deriving (Show)
 271
 272 -- *** Type 'CommandCompileFormat'
 273 data CommandCompileFormat
 274  =   CommandCompileFormat_HTML5
 275      { compile_html5_output_css :: Maybe FilePath
 276      , compile_html5_output_js  :: Maybe FilePath
 277      , compile_html5_dump_dtc   :: Bool
 278      }
 279  |   CommandCompileFormat_XML
 280      {
 281      }
 282  deriving (Show)
 283 instance Default CommandCompileFormat where
 284         def = CommandCompileFormat_HTML5
 285          { compile_html5_output_css = def
 286          , compile_html5_output_js  = def
 287          , compile_html5_dump_dtc   = False
 288          }
 289
 290 -- *** Type 'CommandCompileDump'
 291 data CommandCompileDump
 292  =   CommandCompileDump_TCT
 293  |   CommandCompileDump_XML
 294  |   CommandCompileDump_DTC
 295  |   CommandCompileDump_Deps
 296  deriving (Eq, Ord, Show)
 297
 298 -- ** Type 'CommandSchema'
 299 data CommandSchema
 300  =   CommandSchema
 301  deriving (Show)
 302
 303 -- * Class 'CLI'
 304 class
 305  ( Sym_Fun repr
 306  , Sym_App repr
 307  , Sym_Alt repr
 308  , Sym_AltApp repr
 309  , Sym_Help d repr
 310  , Sym_Rule repr
 311  , Sym_Interleaved repr
 312  , Sym_Command repr
 313  , Sym_Option repr
 314  , Sym_Exit repr
 315  , Plain.Doc d
 316  -- , Reifies lang
 317  ) => CLI d repr where
 318         cli :: Loq d -> Lang -> repr (Exit d) ArgCommand Command
 319         cli loq@(Loqualization l) lang =
 320                 help @d (l10n_cli l) $
 321                 CLI.main "hdoc" $ opts **> cmds
 322                 where
 323                 opts =
 324                         interleaved $
 325                         (\_ _ -> ())
 326                          <<$?   option_help loq (help_usage $ cli loq lang)
 327                          <<|?>> option_version loq
 328                          <<|?>> option_license loq
 329                 cmds =
 330                         Command_Source  <$$> command_source  loq <||>
 331                         Command_Compile <$$> command_compile loq lang <||>
 332                         Command_Schema  <$$> command_schema  loq
 333
 334         option_help :: Loq d -> d -> ((), repr (Exit d) ArgOption ())
 335         option_help (Loqualization l) d =
 336                 ((),) $
 337                 help @d (l10n_help_opt_help l) $
 338                 opt (OptionName 'h' "help") $
 339                 exit $ Exit_Help d
 340         option_version :: Loq d -> ((), repr (Exit d) ArgOption ())
 341         option_version (Loqualization l) = ((),) $
 342                 help @d (l10n_help_version l) $
 343                 long "version" $ exit $ Exit_Version
 344         option_license :: Loq d -> ((), repr (Exit d) ArgOption ())
 345         option_license loq@(Loqualization l) = ((),) $
 346                 help @d (l10n_help_license l) $
 347                 long "license" $ exit $ Exit_License loq
 348         {-
 349         option_input :: Loq d -> (FilePath, repr (Exit d) ArgOption FilePath)
 350         option_input (Loqualization l) =
 351                 (mempty,) $
 352                 help @d (l10n_help_opt_input l) $
 353                 opt (OptionName 'i' "input") $
 354                 string $ l10n_var_file l
 355         -}
 356         option_output :: Loq d -> (FilePath, repr (Exit d) ArgOption FilePath)
 357         option_output (Loqualization l) =
 358                 (mempty,) $
 359                 help @d (l10n_help_opt_output l) $
 360                 opt (OptionName 'o' "output") $
 361                 string $ l10n_var_file l
 362         option_lang :: Loq d -> Lang -> (Lang, repr (Exit d) ArgOption Lang)
 363         option_lang (Loqualization l) lang =
 364                 (lang,) $
 365                 help @d (l10n_help_opt_lang l) $
 366                 long "lang" $
 367                 var (l10n_var_locale l) $ \s ->
 368                         maybe (Left $ Exit_Error $ Error_Locale s) Right $
 369                         Map.lookup (Text.pack s) $
 370                         locales @Langs
 371         option_dump_tct :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 372         option_dump_tct (Loqualization l) =
 373                 help @d (l10n_help_opt_dump_tct l) <$>
 374                 flag (OptionNameLong "dump-tct")
 375         option_dump_xml :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 376         option_dump_xml (Loqualization l) =
 377                 help @d (l10n_help_opt_dump_xml l) <$>
 378                 flag (OptionNameLong "dump-xml")
 379         option_dump_deps :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 380         option_dump_deps (Loqualization l) =
 381                 help @d (l10n_help_opt_dump_deps l) <$>
 382                 flag (OptionNameLong "dump-deps")
 383         option_dump_dtc :: Loq d -> (Bool, repr (Exit d) ArgOption Bool)
 384         option_dump_dtc (Loqualization l) =
 385                 help @d (l10n_help_opt_dump_dtc l) <$>
 386                 flag (OptionNameLong "dump-dtc")
 387
 388         command_source :: Loq d -> repr (Exit d) ArgCommand CommandSource
 389         command_source loq@(Loqualization l) =
 390                 help @d (l10n_help_command_source l) $
 391                 command "source" $
 392                 (interleaved $
 393                         CommandSource
 394                          <<$?   option_help loq (help_usage $ command_source loq)
 395                          <<|?>> option_output   loq
 396                          <<|?>> option_dump_tct loq)
 397                  <**> (command_source_plain loq
 398                   <||> command_source_html5 loq)
 399                  <**> string (l10n_var_file l)
 400         command_source_plain :: Loq d -> repr (Exit d) ArgCommand CommandSourceFormat
 401         command_source_plain loq@(Loqualization l) =
 402                 help @d (l10n_help_format_plain l) $
 403                 command "plain" $
 404                 interleaved $
 405                 CommandSourceFormat_Plain
 406                  <<$?   option_help loq (help_usage $ command_source_plain loq)
 407         command_source_html5 :: Loq d -> repr (Exit d) ArgCommand CommandSourceFormat
 408         command_source_html5 loq@(Loqualization l) =
 409                 help @d (l10n_help_format_html5 l) $
 410                 command "html" $
 411                 interleaved $
 412                 CommandSourceFormat_HTML5
 413                  <<$?   option_help loq (help_usage $ command_source_html5 loq)
 414
 415         command_compile :: Loq d -> Lang -> repr (Exit d) ArgCommand CommandCompile
 416         command_compile loq@(Loqualization l) lang =
 417                 help @d (l10n_help_command_compile l) $
 418                 command "compile" $
 419                 (setDefault <$$>) $
 420                 (interleaved $
 421                         CommandCompile
 422                          <<$?   option_help loq (help_usage $ command_compile loq lang)
 423                          <<|?>> option_output    loq
 424                          <<|?>> option_lang      loq lang
 425                          <<|?>> option_dump_tct  loq
 426                          <<|?>> option_dump_xml  loq
 427                          <<|?>> option_dump_deps loq)
 428                  <**> (command_compile_html5 loq
 429                   <||> command_compile_xml   loq)
 430                  <**> string (l10n_var_file l)
 431                 where
 432                 setDefault a@CommandCompile{..}
 433                  | null compile_output = (a::CommandCompile){compile_output=compile_input-<.>fmt compile_format}
 434                  | otherwise = a
 435                 fmt = \case
 436                  CommandCompileFormat_XML{}   -> "xml"
 437                  CommandCompileFormat_HTML5{} -> "html"
 438         command_compile_html5 :: Loq d -> repr (Exit d) ArgCommand CommandCompileFormat
 439         command_compile_html5 loq@(Loqualization l) =
 440                 help @d (l10n_help_format_html5 l) $
 441                 command "html" $
 442                 interleaved $
 443                         CommandCompileFormat_HTML5
 444                          <<$?   option_help loq (help_usage $ command_compile_html5 loq)
 445                          <<|?>> option_html5_output_css
 446                          <<|?>> option_html5_output_js
 447                          <<|?>> option_dump_dtc loq
 448                 where
 449                 option_html5_output_css =
 450                         (Nothing,) $
 451                         (Just <$$>) $
 452                         help @d (l10n_help_opt_output_css l) $
 453                         opt (OptionNameLong "output-css") $
 454                         string $ l10n_var_file l
 455                 option_html5_output_js =
 456                         (Nothing,) $
 457                         (Just <$$>) $
 458                         help @d (l10n_help_opt_output_js l) $
 459                         opt (OptionNameLong "output-js") $
 460                         string $ l10n_var_file l
 461         command_compile_xml :: Loq d -> repr (Exit d) ArgCommand CommandCompileFormat
 462         command_compile_xml loq@(Loqualization l) =
 463                 help @d (l10n_help_format_xml l) $
 464                 command "xml" $
 465                 interleaved $
 466                 CommandCompileFormat_XML
 467                  <<$?   option_help loq (help_usage $ command_compile_xml loq)
 468
 469         command_schema :: Loq d -> repr (Exit d) ArgCommand CommandSchema
 470         command_schema loq@(Loqualization l) =
 471                 help @d (l10n_help_command_schema l) $
 472                 command "schema" $
 473                 interleaved $
 474                 CommandSchema
 475                  <<$? option_help loq (help_usage $ command_schema loq)
 476 instance Plain.Doc d => CLI d (Plain.Plain d)
 477 instance Plain.Doc d => CLI d Read.Parser
 478 instance Plain.Doc d => CLI d (Help.Help d)
 479
 480 help_usage :: Plain.Doc d => Help.Help d (Exit d) t a -> d
 481 help_usage = Help.textHelp Help.defReader
 482  { Help.reader_command_indent = 2
 483  , Help.reader_option_indent  = 12
 484  }
 485
 486 -- * Type 'Lang'
 487 -- | Supported locales
 488 type Langs = '[FR, EN]
 489 type Lang  = LocaleIn Langs
 490
 491 getLang :: IO Lang
 492 getLang =
 493         (\v -> Map.findWithDefault
 494          (LocaleIn @Langs en_US)
 495          (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
 496          (locales @Langs)) .
 497         fromMaybe ""
 498          <$> Env.lookupEnv "LANG"
 499
 500 -- ** Class 'L10n'
 501 type Loq d = Loqualization (L10n d)
 502 -- | Localization
 503 class L10n_Var lang => L10n d lang where
 504         l10n_cli                  :: FullLocale lang -> d
 505         l10n_license              :: FullLocale lang -> d
 506         l10n_help_version         :: FullLocale lang -> d
 507         l10n_help_license         :: FullLocale lang -> d
 508         l10n_help_command_source  :: FullLocale lang -> d
 509         l10n_help_command_compile :: FullLocale lang -> d
 510         l10n_help_command_schema  :: FullLocale lang -> d
 511         l10n_help_opt_lang        :: FullLocale lang -> d
 512         l10n_help_opt_output      :: FullLocale lang -> d
 513         l10n_help_opt_output_css  :: FullLocale lang -> d
 514         l10n_help_opt_output_js   :: FullLocale lang -> d
 515         l10n_help_opt_dump_tct    :: FullLocale lang -> d
 516         l10n_help_opt_dump_xml    :: FullLocale lang -> d
 517         l10n_help_opt_dump_deps   :: FullLocale lang -> d
 518         l10n_help_opt_dump_dtc    :: FullLocale lang -> d
 519         l10n_help_format          :: FullLocale lang -> d
 520         l10n_help_format_plain    :: FullLocale lang -> d
 521         l10n_help_format_html5    :: FullLocale lang -> d
 522         l10n_help_format_xml      :: FullLocale lang -> d
 523         l10n_help_opt_input       :: FullLocale lang -> d
 524         l10n_help_opt_help        :: FullLocale lang -> d
 525 class L10n_Var lang where
 526         l10n_var_file   :: FullLocale lang -> Name
 527         l10n_var_locale :: FullLocale lang -> Name
 528
 529 -- * Type 'Doc'
 530 data Doc d
 531  =   Doc d
 532  |   Var Name
 533  deriving Show
 534 instance (Semigroup d, IsString d) => Semigroup (Doc d) where
 535         Doc x <> Doc y = Doc (x<>y)
 536         x <> y = Doc $ runDoc x <> runDoc y
 537 instance (Semigroup d, Monoid d, IsString d) => Monoid (Doc d) where
 538         mempty  = Doc mempty
 539         mappend = (<>)
 540 instance Doc.Breakable d => IsString (Doc d) where
 541         fromString = Doc . Plain.words
 542 instance (IsString d, Semigroup d, Monoid d) => IsList (Doc d) where
 543         type Item (Doc d) = Doc d
 544         toList = pure
 545         fromList = Doc . foldMap runDoc
 546 instance (IsString d, Semigroup d) => Doc.Trans (Doc d) where
 547         type ReprOf (Doc d) = d
 548         trans   = Doc
 549         unTrans = runDoc
 550 instance Doc.Breakable d => Doc.Textable (Doc d)
 551 instance (Doc.Breakable d, Doc.Indentable d) => Doc.Indentable (Doc d)
 552 instance Doc.Breakable d => Doc.Breakable (Doc d)
 553 instance (IsString d, Semigroup d, Doc.Decorable d) => Doc.Decorable (Doc d)
 554 instance (IsString d, Semigroup d, Doc.Colorable d) => Doc.Colorable (Doc d)
 555 instance Plain.Doc d => Plain.Doc (Doc d)
 556
 557 runDoc :: (IsString d, Semigroup d) => Doc d -> d
 558 runDoc = \case
 559  Doc d -> d
 560  Var n -> "<"<>fromString n<>">"
 561
 562 instance (IsString d, Semigroup d, Monoid d, Doc.Breakable d) => L10n (Doc d) EN where
 563         l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
 564         l10n_license _ =
 565                 fromString $
 566                 List.intercalate "\n"
 567                  [ "License: GNU GPLv3+"
 568                  , "Copyright: Julien Moutinho <julm+hdoc@autogeree.net>"
 569                  , ""
 570                  , "hdoc is free software: you can redistribute it and/or modify it"
 571                  , "under the terms of the GNU General Public License (GPL)"
 572                  , "as published by the Free Software Foundation;"
 573                  , "either in version 3, or (at your option) any later version."
 574                  , ""
 575                  , "hdoc is distributed in the hope that it will be useful,"
 576                  , "but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY"
 577                  , "or FITNESS FOR A PARTICULAR PURPOSE."
 578                  , ""
 579                  , "See the GNU GPL for more details."
 580                  , "You should have received a copy of the GNU GPL along with hdoc."
 581                  , "If not, see: http://www.gnu.org/licenses/"
 582                  ]
 583         l10n_help_version         _ = "Show the version of this program."
 584         l10n_help_license         _ = "Inform about the license of this program."
 585         l10n_help_command_source  _ = "Format the source code of a TCT document."
 586         l10n_help_command_compile _ = "Compile a TCT document into a format optimized for reading."
 587         l10n_help_command_schema  _ = "Show in RNC (RelaxNG Compact) format the XML schema of the DTC format."
 588         l10n_help_opt_lang        l = ["Use the language given by ", Var $ l10n_var_locale l, "."]
 589         l10n_help_opt_output      l = ["Output document into ", Var $ l10n_var_file l]
 590         l10n_help_opt_output_css  l = [ "Output CSS stylesheet into "
 591                                       , Var $ l10n_var_file l
 592                                       , " (if any), instead of incorporating it into the HTML."
 593                                       ]
 594         l10n_help_opt_output_js   l = [ "Output JavaScript script into "
 595                                       , Var $ l10n_var_file l
 596                                       , " (if any), instead of incorporating it into the HTML."
 597                                       ]
 598         l10n_help_opt_dump_tct    l = [ "Dump internal TCT representation of "
 599                                       , Var $ l10n_var_file l,".tct file,"
 600                                       , " in a"
 601                                       , Var $ l10n_var_file l,".tct.dump file."
 602                                       ]
 603         l10n_help_opt_dump_xml    l = [ "Dump internal XML representation of "
 604                                       , Var $ l10n_var_file l,".tct file,"
 605                                       , " in a"
 606                                       , Var $ l10n_var_file l,".xml.dump file."
 607                                       ]
 608         l10n_help_opt_dump_deps   l = [ "Dump dependencies of ", Var $ l10n_var_file l,".tct file"
 609                                       , " in ", Var $ l10n_var_file l,".deps file,"
 610                                       , " separated by newlines."
 611                                       ]
 612         l10n_help_opt_dump_dtc    _ = "Dump internal representation of DTC."
 613         l10n_help_opt_help        _ = "Show this help."
 614         l10n_help_format          _ = "Output format."
 615         l10n_help_format_plain    _ = "Output as plain text."
 616         l10n_help_format_html5    _ = "Output as HTML5."
 617         l10n_help_format_xml      _ = "Output as XML."
 618         l10n_help_opt_input       l = ["Read input from ", Var $ l10n_var_file l, "."]
 619 instance (IsString d , Semigroup d, Monoid d, Doc.Breakable d) => L10n (Doc d) FR where
 620         l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
 621         l10n_license _ =
 622                 fromString $
 623                 List.intercalate "\n"
 624                  [ "Licence : GPLv3+ GNU"
 625                  , "Droit d’auteur : Julien Moutinho <julm+hdoc@autogeree.net>"
 626                  , ""
 627                  , "hdoc est un logiciel libre : vous pouvez le redistribuer et/ou le modifier"
 628                  , "selon les termes de la Licence Publique Générale (GPL) GNU"
 629                  , "telle que publiée par la Free Software Foundation ;"
 630                  , "en version 3, ou (à votre choix) n’importe quelle version ultérieure."
 631                  , ""
 632                  , "hdoc est distribué dans l’espoir qu’il sera utile,"
 633                  , "mais SANS AUCUNE GARANTIE ; sans même la garantie implicite de COMMERCIALISATION"
 634                  , "ou de CONVENANCE À UN BUT PARTICULIER."
 635                  , ""
 636                  , "Voyez la GPL pour davantage de détails."
 637                  , "Vous devriez avoir reçu une copie de la GPL avec hdoc."
 638                  , "Si non, voyez : http://www.gnu.org/licenses/"
 639                  ]
 640         l10n_help_version         _ = "Affiche la version de ce logiciel."
 641         l10n_help_license         _ = "Informe sur la licence de ce logiciel."
 642         l10n_help_command_source  _ = "Lit un document TCT et écrit un rendu préservant sa syntaxe."
 643         l10n_help_command_compile _ = "Compile un document TCT vers un format optimisé pour la lecture."
 644         l10n_help_command_schema  _ = "Affiche au format RNC (RelaxNG Compact) le schéma XML du format DTC."
 645         l10n_help_opt_lang        l = ["Utilise le langage indiqué par ", Var $ l10n_var_locale l, "."]
 646         l10n_help_opt_output      l = ["Écrit dans ", Var $ l10n_var_file l, "."]
 647         l10n_help_opt_output_css  l = [ "Écrit la feuille de style CSS dans "
 648                                       , Var $ l10n_var_file l
 649                                       , ", au lieu de l’incorporer dans le HTML."
 650                                       ]
 651         l10n_help_opt_output_js   l = [ "Écrit le script JavaScript dans "
 652                                       , Var $ l10n_var_file l
 653                                       , ", au lieu de l’incorporer dans le HTML."
 654                                       ]
 655         l10n_help_opt_dump_tct    l = [ "Écrit la représentation TCT interne de "
 656                                       , Var $ l10n_var_file l,".tct,"
 657                                       , " dans "
 658                                       , Var $ l10n_var_file l,".tct.dump."
 659                                       ]
 660         l10n_help_opt_dump_xml    l = [ "Écrit la représentation XML interne de "
 661                                       , Var $ l10n_var_file l,".tct,"
 662                                       , " dans "
 663                                       , Var $ l10n_var_file l,".xml.dump."
 664                                       ]
 665         l10n_help_opt_dump_deps   l = [ "Écrit les dépendences de ", Var $ l10n_var_file l,".tct"
 666                                       , " dans ", Var $ l10n_var_file l,".deps,"
 667                                       , " séparées par des retours à la ligne."
 668                                       ]
 669         l10n_help_opt_dump_dtc    _ = "Écrit la représentation interne du DTC."
 670         l10n_help_opt_help        _ = "Affiche cette aide."
 671         l10n_help_format          _ = "Format de sortie."
 672         l10n_help_format_plain    _ = "Produit du texte brut."
 673         l10n_help_format_html5    _ = "Produit du HTML5."
 674         l10n_help_format_xml      _ = "Produit du XML."
 675         l10n_help_opt_input       l = ["Lit depuis ", Var $ l10n_var_file l, "."]
 676 instance L10n_Var EN where
 677         l10n_var_file   _ = "file"
 678         l10n_var_locale _ = "locale"
 679 instance L10n_Var FR where
 680         l10n_var_file   _ = "fichier"
 681         l10n_var_locale _ = "locale"