--- /dev/null
+../HLint.hs
\ No newline at end of file
--- /dev/null
+module Main where
+
+import Data.Function (($))
+import System.IO (IO)
+import qualified Symantic.CLI as CLI
+import qualified System.Environment as Env
+
+import Textphile.CLI
+
+main :: IO ()
+main = do
+ args <- Env.getArgs
+ -- putStrLn $ "args: " <> show args
+ parseAPI $ CLI.lexer args
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+module Textphile.CLI where
+
+import Control.Monad (Monad(..))
+import Data.Bool
+import Data.Function (($))
+import Data.Semigroup (Semigroup(..))
+import Data.Text (Text)
+import Data.Void (Void)
+import Symantic.CLI as CLI
+import qualified Data.Text.Lazy.IO as TL
+import qualified Symantic.Document as Doc
+import qualified Symantic.RNC.Write as RNC
+import qualified System.IO as IO
+import qualified Textphile.DTC.Sym as DTC
+
+import Textphile.CLI.Lang
+import Textphile.CLI.Utils
+import Textphile.CLI.Compile
+import Textphile.CLI.Source
+
+parseAPI = parser @Void @Doc api run
+
+api =
+ program "textphile" $
+ api_commands <!>
+ api_help True <!>
+ api_version
+run =
+ run_commands :!:
+ run_help api :!:
+ run_version
+
+api_commands =
+ (api_options <?>) $
+ api_command_compile <!>
+ api_command_source <!>
+ api_command_schema
+run_commands opts =
+ run_command_compile opts :!:
+ run_command_source opts :!:
+ run_command_schema
+
+api_version =
+ helps l10n_help_version $
+ tag (TagLong "version") nothing
+ <.> response @Text
+run_version =
+ return (Doc.from version <> Doc.newline)
+
+api_command_schema =
+ helps l10n_help_command_schema $
+ command "schema" $
+ response @()
+run_command_schema =
+ TL.hPutStrLn IO.stdout $
+ RNC.writeRNC DTC.schema DTC.schema
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+module Textphile.CLI.Compile where
+
+import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Monad (Monad(..), forM_, unless, when)
+import Control.Monad.Trans.Except (runExcept)
+import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.Trans.State.Strict (runState)
+import Data.Bool
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Foldable as Foldable (Foldable(..))
+import Data.Function (($), (.), id, flip)
+import Data.Functor ((<$>))
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Ord (Ord(..))
+import Data.Proxy (Proxy(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Text (Text)
+import Prelude (error)
+import Symantic.CLI as CLI
+import System.FilePath ((-<.>))
+import System.IO (IO, FilePath)
+import Text.Show (Show(..))
+import qualified Data.ByteString as BS
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified Data.TreeSeq.Strict as Tree
+import qualified Paths_textphile as Textphile
+import qualified Symantic.Document as Doc
+import qualified System.Directory as IO
+import qualified System.Environment as Env
+import qualified System.FilePath as FP
+import qualified System.FilePath as FilePath
+import qualified System.IO as IO
+import qualified Text.Blaze.DTC as Blaze.DTC
+import qualified Text.Blaze.HTML5 as Blaze.HTML5
+import qualified Text.Blaze.Renderer.Utf8 as Blaze
+import qualified Text.Blaze.Utils as Blaze
+import qualified Text.Megaparsec as P
+import qualified Textphile.DTC.Read.TCT as DTC
+import qualified Textphile.DTC.Sym as DTC
+import qualified Textphile.DTC.Write.HTML5 as DTC
+import qualified Textphile.DTC.Write.XML as DTC
+import qualified Textphile.TCT as TCT
+import qualified Textphile.TCT.Write.HTML5 as TCT
+import qualified Textphile.TCT.Write.Plain as TCT
+import qualified Textphile.TCT.Write.XML as TCT
+import qualified Textphile.Utils as FS
+
+import Textphile.CLI.Lang
+import Textphile.CLI.Utils
+
+data Cfg_Compile = Cfg_Compile
+ { cfg_compile_dump_tct :: Bool
+ , cfg_compile_dump_xml :: Bool
+ , cfg_compile_dump_deps :: Bool
+ } deriving (Show)
+
+data Cfg_Compile_HTML5
+ = Cfg_Compile_HTML5
+ { cfg_compile_html5_output_css :: Maybe FP.FilePath
+ , cfg_compile_html5_output_js :: Maybe FP.FilePath
+ , cfg_compile_html5_dump_dtc :: Bool
+ }
+
+api_command_compile =
+ helps l10n_help_command_compile $
+ command "compile" $
+ (Cfg_Compile
+ <$> api_dump_tct
+ <*> api_dump_xml
+ <*> api_dump_deps
+ )
+ <?> api_format
+ -- <!> api_help False
+ where
+ api_dump_tct =
+ flag "dump-tct"
+ api_dump_xml =
+ flag "dump-xml"
+ api_dump_deps =
+ flag "dump-deps"
+ api_format =
+ api_format_html5 <!>
+ api_format_xml
+ api_output_css =
+ helps l10n_help_opt_output_css $
+ optionalTag "output-css" $
+ var "FILE"
+ api_output_js =
+ helps l10n_help_opt_output_js $
+ optionalTag "output-js" $
+ var "FILE"
+ api_dump_dtc =
+ flag "dump-dtc"
+ api_format_html5 =
+ command "html5" $
+ (Cfg_Compile_HTML5
+ <$> api_output_css
+ <*> api_output_js
+ <*> api_dump_dtc
+ )
+ <?> api_input
+ <.> response @()
+ api_format_xml =
+ command "xml" $
+ api_input
+ <.> response @()
+ api_input =
+ helps l10n_help_opt_input $
+ var @FP.FilePath "INPUT"
+
+run_command_compile
+ cfg_global@Cfg_Global{..}
+ cfg_compile@Cfg_Compile{..} =
+ run_compile_html5 :!:
+ run_compile_xml
+ where
+ run_compile_dtc cfg_compile_input cfg_compile_output = do
+ outputInfo cfg_global $ "compiling... " <> Doc.from cfg_compile_input
+ TCT.readTCT cfg_compile_input >>= \case
+ Left err -> error $ show err
+ Right tct -> do
+ when cfg_compile_dump_tct $ do
+ FS.writeFile (cfg_compile_output-<.>"tct.dump") $
+ TL.pack $ Tree.prettyTrees tct
+ let xml = TCT.writeXML tct
+ when cfg_compile_dump_xml $ do
+ FS.writeFile (cfg_compile_output-<.>"xml.dump") $
+ TL.pack $ Tree.prettyTrees xml
+ case DTC.readDTC xml of
+ Left err -> do
+ FS.removeFile $ cfg_compile_output-<.>"deps"
+ error $ List.unlines $ Foldable.toList $ P.parseErrorPretty <$> P.bundleErrors err
+ Right dtc -> do
+ when cfg_compile_dump_deps $ do
+ writeDependencies cfg_compile cfg_compile_input tct
+ when cfg_compile_dump_xml $ do
+ FS.writeFile (cfg_compile_output-<.>"dtc.dump") $
+ TL.pack $ show dtc
+ return dtc
+ run_compile_html5 Cfg_Compile_HTML5{..} cfg_compile_input = do
+ let cfg_compile_output = cfg_compile_input-<.>"html5"
+ dtc <- run_compile_dtc cfg_compile_input cfg_compile_output
+ config_css <- installFile cfg_compile_html5_output_css $ "style" FilePath.</>"dtc-html5.css"
+ config_js <- installFile cfg_compile_html5_output_js $ "style" FilePath.</>"dtc-html5.js"
+ let conf = DTC.Config
+ { DTC.config_css
+ , DTC.config_js
+ , DTC.config_locale = cfg_global_lang
+ , DTC.config_generator = TL.fromStrict version
+ }
+ FS.withFile cfg_compile_output IO.WriteMode $ \h -> do
+ html <- DTC.writeHTML5 conf dtc
+ Blaze.prettyMarkupIO
+ Blaze.HTML5.isInlinedElement
+ (BS.hPutStr h)
+ html
+ where
+ installFile out name = do
+ dataDir <- Textphile.getDataDir
+ let src = dataDir FilePath.</>name
+ case out of
+ Nothing -> Right <$> FS.readFile src
+ Just "" -> return $ Left ""
+ Just dst -> do
+ IO.createDirectoryIfMissing True $ FilePath.takeDirectory dst
+ IO.copyFile src dst
+ return $ Left dst
+ run_compile_xml cfg_compile_input = do
+ let cfg_compile_output = cfg_compile_input-<.>"xml"
+ dtc <- run_compile_dtc cfg_compile_input cfg_compile_output
+ FS.withFile cfg_compile_output IO.WriteMode $ \h ->
+ Blaze.prettyMarkupIO Blaze.DTC.isInlinedElement (BS.hPutStr h) $
+ DTC.writeXML cfg_global_lang dtc
+
+writeDependencies :: Cfg_Compile -> FilePath -> TCT.Roots -> IO ()
+writeDependencies Cfg_Compile{..} cfg_compile_input tct =
+ let dir = FilePath.takeDirectory cfg_compile_input in
+ FS.writeFile (cfg_compile_input-<.>"deps") $
+ foldMap (TL.pack . (("\n" <>) . FilePath.normalise))
+ ((dir FilePath.</>) <$> TCT.dependencies tct) <>
+ "\n"
--- /dev/null
+../HLint.hs
\ No newline at end of file
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Textphile.CLI.Lang where
+
+import Control.Applicative (Applicative(..), (<*), liftA2, liftA3)
+import Control.Monad.Trans.Reader (Reader, runReader, ReaderT, runReaderT, ask)
+import Data.Bool
+import Data.Eq (Eq(..))
+import Data.Function (($), (.))
+import Data.Functor (Functor(..), (<$>))
+import Data.Locale
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Monoid (Monoid(..))
+import Data.Semigroup (Semigroup(..))
+import Data.String (String, IsString(..))
+import Data.Text (Text)
+import Symantic.CLI (Outputable(..), OnHandle(..), IOType)
+import System.IO (IO, FilePath)
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy.Builder as TLB
+import qualified Symantic.CLI as CLI
+import qualified Symantic.Document as Doc
+import qualified System.Environment as Env
+
+type Doc = Reader Loq (Doc.Plain TLB.Builder)
+
+instance (Semigroup d, Applicative m) => Semigroup (ReaderT r m (Doc.Plain d)) where
+ (<>) = liftA2 (<>)
+instance (Monoid d, Applicative m) => Monoid (ReaderT r m (Doc.Plain d)) where
+ mempty = pure mempty
+ mappend = liftA2 mappend
+instance
+ ( Doc.From (Doc.Word String) d
+ , Applicative m
+ , Doc.Spaceable d
+ ) => IsString (ReaderT r m (Doc.Plain d)) where
+ fromString = pure . fromString
+instance
+ ( Applicative m
+ , Doc.Spaceable d
+ ) => Doc.Spaceable (ReaderT r m (Doc.Plain d)) where
+ newline = pure Doc.newline
+ space = pure Doc.space
+instance
+ ( Functor m
+ , Semigroup d
+ , Doc.From [Doc.SGR] d
+ ) => Doc.Colorable16 (ReaderT r m (Doc.Plain d)) where
+ reverse = fmap Doc.reverse
+ black = fmap Doc.black
+ red = fmap Doc.red
+ green = fmap Doc.green
+ yellow = fmap Doc.yellow
+ blue = fmap Doc.blue
+ magenta = fmap Doc.magenta
+ cyan = fmap Doc.cyan
+ white = fmap Doc.white
+ blacker = fmap Doc.blacker
+ redder = fmap Doc.redder
+ greener = fmap Doc.greener
+ yellower = fmap Doc.yellower
+ bluer = fmap Doc.bluer
+ magentaer = fmap Doc.magentaer
+ cyaner = fmap Doc.cyaner
+ whiter = fmap Doc.whiter
+ onBlack = fmap Doc.onBlack
+ onRed = fmap Doc.onRed
+ onGreen = fmap Doc.onGreen
+ onYellow = fmap Doc.onYellow
+ onBlue = fmap Doc.onBlue
+ onMagenta = fmap Doc.onMagenta
+ onCyan = fmap Doc.onCyan
+ onWhite = fmap Doc.onWhite
+ onBlacker = fmap Doc.onBlacker
+ onRedder = fmap Doc.onRedder
+ onGreener = fmap Doc.onGreener
+ onYellower = fmap Doc.onYellower
+ onBluer = fmap Doc.onBluer
+ onMagentaer = fmap Doc.onMagentaer
+ onCyaner = fmap Doc.onCyaner
+ onWhiter = fmap Doc.onWhiter
+instance
+ ( Applicative m
+ , Semigroup d
+ , Doc.From [Doc.SGR] d
+ ) => Doc.Decorable (ReaderT r m (Doc.Plain d)) where
+ bold = fmap Doc.bold
+ underline = fmap Doc.underline
+ italic = fmap Doc.italic
+instance
+ ( Applicative m
+ , Semigroup d
+ , Doc.Spaceable d
+ ) => Doc.Wrappable (ReaderT r m (Doc.Plain d)) where
+ setWidth w = fmap (Doc.setWidth w)
+ breakpoint = pure Doc.breakpoint
+ breakspace = pure Doc.breakspace
+ breakalt = liftA2 Doc.breakalt
+ endline = pure Doc.endline
+instance
+ ( Applicative m
+ , Semigroup d
+ , Doc.Spaceable d
+ ) => Doc.Justifiable (ReaderT r m (Doc.Plain d)) where
+ justify = fmap Doc.justify
+instance
+ ( Applicative m
+ , Semigroup d
+ , Doc.Spaceable d
+ ) => Doc.Indentable (ReaderT r m (Doc.Plain d)) where
+ align = fmap Doc.align
+ setIndent d i x = Doc.setIndent <$> d <*> pure i <*> x
+ incrIndent d i x = Doc.incrIndent <$> d <*> pure i <*> x
+ fill i = fmap (Doc.fill i)
+ fillOrBreak i = fmap (Doc.fillOrBreak i)
+instance
+ ( Applicative m
+ , Semigroup d
+ , Doc.Lengthable s
+ , Doc.From (Doc.Word s) d
+ ) => Doc.From (Doc.Word s) (ReaderT r m (Doc.Plain d)) where
+ from = pure . Doc.from
+instance Doc.From String Doc where
+ from = pure . Doc.from
+instance Doc.From Text Doc where
+ from = pure . Doc.from
+
+instance IOType Doc
+instance Outputable Doc where
+ output d = do
+ lang <- getLang
+ output $ runReader d $ loqualize lang
+instance Outputable (OnHandle Doc) where
+ output (OnHandle h d) = do
+ lang <- getLang
+ output $ OnHandle h $ runReader d $ loqualize lang
+
+getLang :: IO Lang
+getLang =
+ (\v -> Map.findWithDefault
+ (LocaleIn @Langs en_US)
+ (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
+ (locales @Langs)) .
+ fromMaybe ""
+ <$> Env.lookupEnv "LANG"
+
+type Name = Text
+
+-- * Type 'Lang'
+-- | Supported locales
+type Langs = '[FR, EN]
+type Lang = LocaleIn Langs
+
+l10n_var v = "<"<>Doc.from v<>">"
+ref = Doc.underline
+con = Doc.between "\"" "\""
+fileRef = ref
+
+-- ** Class 'L10n'
+type Loq = Loqualization L10n
+
+helps ::
+ CLI.CLI_Help repr =>
+ CLI.HelpConstraint repr Doc =>
+ (forall lang. L10n lang => FullLocale lang -> Doc.Plain TLB.Builder) ->
+ repr f k -> repr f k
+helps f = CLI.help @_ @Doc (Doc.justify ((\(Loqualization fl) -> f fl) <$> ask))
+infixr 0 `helps`
+
+-- | Localization
+class L10n_Var lang => L10n lang where
+ l10n_cli :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_license :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_version :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_license :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_command_source :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_command_compile :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_command_schema :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_lang :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_output :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_output_css :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_output_js :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_dump_tct :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_dump_xml :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_dump_deps :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_dump_dtc :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_format :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_format_plain :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_format_html5 :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_format_xml :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_input :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_help_full :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_help_compact :: FullLocale lang -> Doc.Plain TLB.Builder
+ l10n_help_opt_verbosity :: FullLocale lang -> Doc.Plain TLB.Builder
+
+instance L10n EN where
+ l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
+ l10n_license _ =
+ fromString $
+ List.intercalate "\n"
+ [ "License: GNU GPLv3+"
+ , "Copyright: Julien Moutinho <julm+textphile@sourcephile.fr>"
+ , ""
+ , "hdoc is free software: you can redistribute it and/or modify it"
+ , "under the terms of the GNU General Public License (GPL)"
+ , "as published by the Free Software Foundation;"
+ , "either in version 3, or (at your option) any later version."
+ , ""
+ , "hdoc is distributed in the hope that it will be useful,"
+ , "but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY"
+ , "or FITNESS FOR A PARTICULAR PURPOSE."
+ , ""
+ , "See the GNU GPL for more details."
+ , "You should have received a copy of the GNU GPL along with hdoc."
+ , "If not, see: http://www.gnu.org/licenses/"
+ ]
+ l10n_help_version _ = "Show the version of this program."
+ l10n_help_license _ = "Inform about the license of this program."
+ l10n_help_command_source _ = "Format the source code of a TCT document."
+ l10n_help_command_compile _ = "Compile a TCT document into a format optimized for reading."
+ l10n_help_command_schema _ = "Show in RNC (RelaxNG Compact) format the XML schema of the DTC format."
+ l10n_help_opt_lang l = mconcat
+ [ "Use the language given by "
+ , l10n_var $ l10n_var_locale l
+ , "."
+ ]
+ l10n_help_opt_output l = mconcat
+ [ "Output document into "
+ , l10n_var $ l10n_var_file l
+ ]
+ l10n_help_opt_output_css l = mconcat
+ [ "Output CSS stylesheet into "
+ , l10n_var $ l10n_var_file l
+ , " (if any), instead of incorporating it into the HTML."
+ ]
+ l10n_help_opt_output_js l = mconcat
+ [ "Output JavaScript script into "
+ , l10n_var $ l10n_var_file l
+ , " (if any), instead of incorporating it into the HTML."
+ ]
+ l10n_help_opt_dump_tct l = mconcat
+ [ "Dump internal TCT representation of "
+ , l10n_var $ l10n_var_file l,".tct file,"
+ , " in a"
+ , l10n_var $ l10n_var_file l,".tct.dump file."
+ ]
+ l10n_help_opt_dump_xml l = mconcat
+ [ "Dump internal XML representation of "
+ , l10n_var $ l10n_var_file l,".tct file,"
+ , " in a"
+ , l10n_var $ l10n_var_file l,".xml.dump file."
+ ]
+ l10n_help_opt_dump_deps l = mconcat
+ [ "Dump dependencies of ", l10n_var $ l10n_var_file l,".tct file"
+ , " in ", l10n_var $ l10n_var_file l,".deps file,"
+ , " separated by newlines."
+ ]
+ l10n_help_opt_dump_dtc _ = "Dump internal representation of DTC."
+ l10n_help_opt_help_full _ = "Print a commented grammar tree to help using this program."
+ l10n_help_opt_help_compact _ = "Print an uncommented grammar tree to help using this program."
+ l10n_help_format _ = "Output format."
+ l10n_help_format_plain _ = "Output as plain text."
+ l10n_help_format_html5 _ = "Output as HTML5."
+ l10n_help_format_xml _ = "Output as XML."
+ l10n_help_opt_input l = mconcat
+ [ "Read input from ", l10n_var $ l10n_var_file l, "." ]
+ l10n_help_opt_verbosity _ =
+ "Verbosity level.\
+ \\n(default: "<>con "info"<>")"
+instance L10n FR where
+ l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
+ l10n_license _ =
+ fromString $
+ List.intercalate "\n"
+ [ "Licence : GPLv3+ GNU"
+ , "Auteur : Julien Moutinho <julm+textphile@sourcephile.fr>"
+ , ""
+ , "textphile est un logiciel libre : vous pouvez le redistribuer et/ou le modifier"
+ , "selon les termes de la Licence Publique Générale (GPL) GNU"
+ , "telle que publiée par la Free Software Foundation ;"
+ , "en version 3, ou (à votre choix) n’importe quelle version ultérieure."
+ , ""
+ , "textphile est distribué dans l’espoir qu’il sera utile,"
+ , "mais SANS AUCUNE GARANTIE ; sans même la garantie implicite de COMMERCIALISATION"
+ , "ou de CONVENANCE À UN BUT PARTICULIER."
+ , ""
+ , "Voyez la GPL pour davantage de détails."
+ , "Vous devriez avoir reçu une copie de la GPL avec textphile."
+ , "Si non, voyez : http://www.gnu.org/licenses/"
+ ]
+ l10n_help_version _ = "Affiche la version de ce logiciel."
+ l10n_help_license _ = "Informe sur la licence de ce logiciel."
+ l10n_help_command_source _ = "Lit un document TCT et écrit un rendu préservant sa syntaxe."
+ l10n_help_command_compile _ = "Compile un document TCT vers un format optimisé pour la lecture."
+ l10n_help_command_schema _ = "Affiche au format RNC (RelaxNG Compact) le schéma XML du format DTC."
+ l10n_help_opt_lang l = mconcat
+ [ "Utilise le langage indiqué par "
+ , l10n_var $ l10n_var_locale l, "." ]
+ l10n_help_opt_output l = mconcat
+ [ "Écrit dans ", l10n_var $ l10n_var_file l, "." ]
+ l10n_help_opt_output_css l = mconcat
+ [ "Écrit la feuille de style CSS dans "
+ , l10n_var $ l10n_var_file l
+ , ", au lieu de l’incorporer dans le HTML."
+ ]
+ l10n_help_opt_output_js l = mconcat
+ [ "Écrit le script JavaScript dans "
+ , l10n_var $ l10n_var_file l
+ , ", au lieu de l’incorporer dans le HTML."
+ ]
+ l10n_help_opt_dump_tct l = mconcat
+ [ "Écrit la représentation TCT interne de "
+ , l10n_var $ l10n_var_file l,".tct,"
+ , " dans "
+ , l10n_var $ l10n_var_file l,".tct.dump."
+ ]
+ l10n_help_opt_dump_xml l = mconcat
+ [ "Écrit la représentation XML interne de "
+ , l10n_var $ l10n_var_file l,".tct,"
+ , " dans "
+ , l10n_var $ l10n_var_file l,".xml.dump."
+ ]
+ l10n_help_opt_dump_deps l = mconcat
+ [ "Écrit les dépendences de ", l10n_var $ l10n_var_file l,".tct"
+ , " dans ", l10n_var $ l10n_var_file l,".deps,"
+ , " séparées par des retours à la ligne."
+ ]
+ l10n_help_opt_dump_dtc _ = "Écrit la représentation interne du DTC."
+ l10n_help_opt_help_full _ = "Affiche un arbre grammatical avec commentaires pour aider à utiliser ce programme."
+ l10n_help_opt_help_compact _ = "Affiche un arbre grammatical sans commentaires pour aider à utiliser ce programme."
+ l10n_help_format _ = "Format de sortie."
+ l10n_help_format_plain _ = "Produit du texte brut."
+ l10n_help_format_html5 _ = "Produit du HTML5."
+ l10n_help_format_xml _ = "Produit du XML."
+ l10n_help_opt_input l = mconcat
+ [ "Lit depuis ", l10n_var $ l10n_var_file l, "." ]
+ l10n_help_opt_verbosity _ =
+ "Niveau de verbosité.\
+ \\n(défault : "<>con "info"<>")"
+
+-- ** Class 'L10n_Var'
+class L10n_Var lang where
+ l10n_var_file :: FullLocale lang -> Name
+ l10n_var_locale :: FullLocale lang -> Name
+instance L10n_Var EN where
+ l10n_var_file _ = "file"
+ l10n_var_locale _ = "locale"
+instance L10n_Var FR where
+ l10n_var_file _ = "fichier"
+ l10n_var_locale _ = "locale"
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+module Textphile.CLI.Source where
+
+import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Monad (Monad(..), forM_, unless, when)
+import Control.Monad.Trans.Except (runExcept)
+import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.Trans.State.Strict (runState)
+import Data.Bool
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Foldable as Foldable (Foldable(..))
+import Data.Function (($), (.), id, flip)
+import Data.Functor ((<$>))
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Ord (Ord(..))
+import Data.Proxy (Proxy(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Text (Text)
+import Prelude (error)
+import Symantic.CLI as CLI
+import System.FilePath ((-<.>))
+import System.IO (IO, FilePath)
+import Text.Show (Show(..))
+import qualified Data.ByteString as BS
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified Data.TreeSeq.Strict as Tree
+import qualified Paths_textphile as Textphile
+import qualified Symantic.Document as Doc
+import qualified System.Directory as IO
+import qualified System.Environment as Env
+import qualified System.FilePath as FP
+import qualified System.FilePath as FilePath
+import qualified System.IO as IO
+import qualified Text.Blaze.DTC as Blaze.DTC
+import qualified Text.Blaze.HTML5 as Blaze.HTML5
+import qualified Text.Blaze.Renderer.Utf8 as Blaze
+import qualified Text.Blaze.Utils as Blaze
+import qualified Text.Megaparsec as P
+import qualified Textphile.DTC.Read.TCT as DTC
+import qualified Textphile.DTC.Sym as DTC
+import qualified Textphile.DTC.Write.HTML5 as DTC
+import qualified Textphile.DTC.Write.XML as DTC
+import qualified Textphile.TCT as TCT
+import qualified Textphile.TCT.Write.HTML5 as TCT
+import qualified Textphile.TCT.Write.Plain as TCT
+import qualified Textphile.TCT.Write.XML as TCT
+import qualified Textphile.Utils as FS
+
+import Textphile.CLI.Lang
+import Textphile.CLI.Utils
+
+data Cfg_Source = Cfg_Source
+ { cfg_source_dump_tct :: Bool
+ }
+
+api_command_source =
+ helps l10n_help_command_source $
+ command "source" $
+ (Cfg_Source
+ <$> api_dump_tct
+ )
+ <?> api_format
+ where
+ api_dump_tct =
+ flag "dump-tct"
+ api_format =
+ api_format_plain <!>
+ api_format_html5
+ api_format_plain =
+ command "plain" $
+ api_input
+ <.> response @()
+ api_format_html5 =
+ command "html5" $
+ api_input
+ <.> response @()
+ api_input =
+ helps l10n_help_opt_input $
+ var @FP.FilePath "INPUT"
+
+run_command_source
+ cfg_global@Cfg_Global{..}
+ cfg_source@Cfg_Source{..} =
+ run_source_plain :!:
+ run_source_html5
+ where
+ run_source_tct cfg_source_input cfg_source_output = do
+ TCT.readTCT cfg_source_input >>= \case
+ Left err -> error $ show err
+ Right tct -> do
+ when cfg_source_dump_tct $
+ FS.writeFile (cfg_source_output-<.>"tct.dump") $
+ TL.pack $ Tree.prettyTrees tct
+ return tct
+ run_source_plain cfg_source_input = do
+ let cfg_source_output = cfg_source_input FilePath.<.>"txt"
+ tct <- run_source_tct cfg_source_input cfg_source_output
+ FS.writeFile cfg_source_output $
+ TCT.writePlain tct
+ run_source_html5 cfg_source_input = do
+ let cfg_source_output = cfg_source_input FilePath.<.>"html5"
+ tct <- run_source_tct cfg_source_input cfg_source_output
+ FS.withFile cfg_source_output IO.WriteMode $ \h ->
+ Blaze.renderMarkupToByteStringIO (BS.hPutStr h) $
+ TCT.writeHTML5 tct
--- /dev/null
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE StrictData #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Textphile.CLI.Utils where
+
+import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Arrow (left)
+import Control.Monad (Monad(..), forM_, when)
+import Control.Monad.Trans.Maybe (MaybeT(..))
+import Control.Monad.Trans.Except (runExceptT)
+import Control.Monad.Trans.Reader (Reader, runReader)
+import Data.Bool
+import Data.Either (Either(..))
+import Data.Eq (Eq(..))
+import Data.Foldable (Foldable)
+import Data.Function (($), (.), id)
+import Data.Functor ((<$>))
+import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (Monoid(..))
+import Data.Ord (Ord(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Prelude (min, max, (-))
+import Symantic.CLI as CLI
+import System.IO (IO)
+import Text.Show (Show(..))
+import qualified Control.Monad.Classes as MC
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy.Char8 as BSL8
+import qualified Data.Char as Char
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as T
+import qualified Symantic.Document as Doc
+import qualified System.Console.Terminal.Size as Console
+import qualified System.Directory as IO
+import qualified System.FilePath as FP
+import qualified System.IO as IO
+import qualified System.Posix as Posix
+import qualified Data.Version as Version
+import qualified Paths_textphile as Textphile
+
+import Data.Locale
+import Textphile.CLI.Lang
+
+progname :: Text
+progname = "textphile"
+
+version :: Text
+version =
+ progname <> "-" <>
+ Text.pack (Version.showVersion Textphile.version)
+
+api_help full =
+ if full
+ then
+ api_compact <.> response @Doc <!>
+ api_full <.> response @Doc
+ else
+ (api_compact <!> api_full) <.> response @Doc
+ where
+ api_compact =
+ (if full then helps l10n_help_opt_help_compact else id) $
+ tag "h" (just False)
+ api_full =
+ (if full then helps l10n_help_opt_help_full else id) $
+ tag "help" (just True)
+
+run_help lay = route :!: route
+ where
+ route helpInh_full = do
+ width <- Just . maybe 80 (min 80 . max 0 . (\x -> x - 2) . Console.width)
+ <$> Console.size
+ return $
+ Doc.setWidth width $
+ runLayout helpInh_full lay
+
+-- * Type 'Cfg_Global'
+data Cfg_Global
+ = Cfg_Global
+ { cfg_global_stderr_prepend_newline :: Bool
+ , cfg_global_stderr_prepend_carriage :: Bool
+ , cfg_global_stderr_append_newline :: Bool
+ , cfg_global_verbosity :: Verbosity
+ , cfg_global_lang :: Lang
+ }
+
+api_options =
+ rule "OPTIONS" $
+ Cfg_Global False False True
+ <$> api_param_verbosity
+ <*> api_param_lang
+api_param_lang =
+ (\v -> Map.findWithDefault
+ (LocaleIn @Langs en_US)
+ (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
+ (locales @Langs)) <$>
+ toPermDefault "en_US" (env "LANG")
+
+-- * Type 'Verbosity'
+data Verbosity
+ = Verbosity_Error
+ | Verbosity_Warning
+ | Verbosity_Info
+ | Verbosity_Debug
+ deriving (Eq,Ord)
+
+instance IOType Verbosity
+instance FromSegment Verbosity where
+ fromSegment = \case
+ "error" -> return $ Right Verbosity_Error
+ "warning" -> return $ Right Verbosity_Warning
+ "info" -> return $ Right Verbosity_Info
+ "debug" -> return $ Right Verbosity_Debug
+ _ -> return $ Left "invalid verbosity"
+
+api_param_verbosity =
+ helps l10n_help_opt_verbosity $
+ toPermDefault Verbosity_Info $
+ tag "verbosity" (
+ constant "error" Verbosity_Error `alt`
+ constant "warning" Verbosity_Warning `alt`
+ constant "info" Verbosity_Info `alt`
+ constant "debug" Verbosity_Debug
+ ) `alt`
+ env "TEXTPHILE_VERBOSITY"
+
+outputMessage :: MC.MonadExec IO m => Cfg_Global -> Doc -> Doc -> m ()
+outputMessage Cfg_Global{..} hdr msg =
+ MC.exec @IO $ output $ OnHandle IO.stderr $ (`runReader` loqualize cfg_global_lang) $
+ (if cfg_global_stderr_prepend_newline then Doc.newline else mempty) <>
+ (if cfg_global_stderr_prepend_carriage then "\r" else mempty) <>
+ hdr<>": "<>msg<>
+ (if cfg_global_stderr_append_newline then Doc.newline else mempty)
+
+outputError :: MC.MonadExec IO m => Cfg_Global -> Doc -> MaybeT m a
+outputError cfg_global@Cfg_Global{..} msg = do
+ when (Verbosity_Error <= cfg_global_verbosity) $ do
+ outputMessage cfg_global (Doc.redder "ERROR") msg
+ empty
+
+outputWarning :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
+outputWarning cfg_global@Cfg_Global{..} msg = do
+ when (Verbosity_Warning <= cfg_global_verbosity) $ do
+ outputMessage cfg_global (Doc.yellower "WARNING") msg
+
+outputInfo :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
+outputInfo cfg_global@Cfg_Global{..} msg = do
+ when (Verbosity_Info <= cfg_global_verbosity) $ do
+ outputMessage cfg_global (Doc.greener "info") msg
+
+outputDebug :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
+outputDebug cfg_global@Cfg_Global{..} msg = do
+ when (Verbosity_Debug <= cfg_global_verbosity) $ do
+ outputMessage cfg_global (Doc.magentaer "debug") msg
--- /dev/null
+../HLint.hs
\ No newline at end of file
import qualified Textphile.TCT.Cell as TCT
import qualified Textphile.Utils as FS
import qualified Textphile.XML as XML
-import qualified Paths_hdoc as Textphile
+import qualified Paths_textphile as Textphile
import Debug.Trace
debug :: Show a => String -> a -> a
-- PVP: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
-version: 0.0.0.20180213
+version: 0.0.0.20200303
category: Language
synopsis: Library and tools for technical and convivial documents
stability: experimental
, judgmentphile-majority >= 0.0
, hxt-charproperties >= 9.2
, localization >= 1.0.1
- , symantic-cli >= 0.0.0
, symantic-xml >= 0.0.0
, megaparsec >= 7.0.4
, mono-traversable >= 1.0
Textphile.CLI
Textphile.CLI.Compile
Textphile.CLI.Lang
+ Textphile.CLI.Source
Textphile.CLI.Utils
default-language: Haskell2010
default-extensions:
, safe >= 0.3
, semigroups >= 0.18
, symantic-document >= 0.1
- , symantic-cli >= 0.0
+ , symantic-cli >= 2.4.3
, symantic-xml >= 0.0
, strict >= 0.3
, terminal-size >= 0.3
sourcephile / git / doclang.git / commitdiff