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