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