1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Textphile.CLI.Lang where
6 import Control.Applicative (Applicative(..), (<*), liftA2, liftA3)
7 import Control.Monad.Trans.Reader (Reader, runReader, ReaderT, runReaderT, ask)
9 import Data.Eq (Eq(..))
10 import Data.Function (($), (.))
11 import Data.Functor (Functor(..), (<$>))
13 import Data.Maybe (Maybe(..), fromMaybe, maybe)
14 import Data.Monoid (Monoid(..))
15 import Data.Semigroup (Semigroup(..))
16 import Data.String (String, IsString(..))
17 import Data.Text (Text)
18 import Symantic.CLI (Outputable(..), OnHandle(..), IOType)
19 import System.IO (IO, FilePath)
20 import qualified Data.Char as Char
21 import qualified Data.List as List
22 import qualified Data.Map.Strict as Map
23 import qualified Data.Text as Text
24 import qualified Data.Text.Lazy.Builder as TLB
25 import qualified Symantic.CLI as CLI
26 import qualified Symantic.Document as Doc
27 import qualified System.Environment as Env
29 type Doc = Reader Loq (Doc.Plain TLB.Builder)
31 instance (Semigroup d, Applicative m) => Semigroup (ReaderT r m (Doc.Plain d)) where
33 instance (Monoid d, Applicative m) => Monoid (ReaderT r m (Doc.Plain d)) where
35 mappend = liftA2 mappend
37 ( Doc.From (Doc.Word String) d
40 ) => IsString (ReaderT r m (Doc.Plain d)) where
41 fromString = pure . fromString
45 ) => Doc.Spaceable (ReaderT r m (Doc.Plain d)) where
46 newline = pure Doc.newline
47 space = pure Doc.space
51 , Doc.From [Doc.SGR] d
52 ) => Doc.Colorable16 (ReaderT r m (Doc.Plain d)) where
53 reverse = fmap Doc.reverse
54 black = fmap Doc.black
56 green = fmap Doc.green
57 yellow = fmap Doc.yellow
59 magenta = fmap Doc.magenta
61 white = fmap Doc.white
62 blacker = fmap Doc.blacker
63 redder = fmap Doc.redder
64 greener = fmap Doc.greener
65 yellower = fmap Doc.yellower
66 bluer = fmap Doc.bluer
67 magentaer = fmap Doc.magentaer
68 cyaner = fmap Doc.cyaner
69 whiter = fmap Doc.whiter
70 onBlack = fmap Doc.onBlack
71 onRed = fmap Doc.onRed
72 onGreen = fmap Doc.onGreen
73 onYellow = fmap Doc.onYellow
74 onBlue = fmap Doc.onBlue
75 onMagenta = fmap Doc.onMagenta
76 onCyan = fmap Doc.onCyan
77 onWhite = fmap Doc.onWhite
78 onBlacker = fmap Doc.onBlacker
79 onRedder = fmap Doc.onRedder
80 onGreener = fmap Doc.onGreener
81 onYellower = fmap Doc.onYellower
82 onBluer = fmap Doc.onBluer
83 onMagentaer = fmap Doc.onMagentaer
84 onCyaner = fmap Doc.onCyaner
85 onWhiter = fmap Doc.onWhiter
89 , Doc.From [Doc.SGR] d
90 ) => Doc.Decorable (ReaderT r m (Doc.Plain d)) where
92 underline = fmap Doc.underline
93 italic = fmap Doc.italic
98 ) => Doc.Wrappable (ReaderT r m (Doc.Plain d)) where
99 setWidth w = fmap (Doc.setWidth w)
100 breakpoint = pure Doc.breakpoint
101 breakspace = pure Doc.breakspace
102 breakalt = liftA2 Doc.breakalt
103 endline = pure Doc.endline
108 ) => Doc.Justifiable (ReaderT r m (Doc.Plain d)) where
109 justify = fmap Doc.justify
114 ) => Doc.Indentable (ReaderT r m (Doc.Plain d)) where
115 align = fmap Doc.align
116 setIndent d i x = Doc.setIndent <$> d <*> pure i <*> x
117 incrIndent d i x = Doc.incrIndent <$> d <*> pure i <*> x
118 fill i = fmap (Doc.fill i)
119 fillOrBreak i = fmap (Doc.fillOrBreak i)
124 , Doc.From (Doc.Word s) d
125 ) => Doc.From (Doc.Word s) (ReaderT r m (Doc.Plain d)) where
126 from = pure . Doc.from
127 instance Doc.From String Doc where
128 from = pure . Doc.from
129 instance Doc.From Text Doc where
130 from = pure . Doc.from
133 instance Outputable Doc where
136 output $ runReader d $ loqualize lang
137 instance Outputable (OnHandle Doc) where
138 output (OnHandle h d) = do
140 output $ OnHandle h $ runReader d $ loqualize lang
144 (\v -> Map.findWithDefault
145 (LocaleIn @Langs en_US)
146 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
149 <$> Env.lookupEnv "LANG"
154 -- | Supported locales
155 type Langs = '[FR, EN]
156 type Lang = LocaleIn Langs
158 l10n_var v = "<"<>Doc.from v<>">"
160 con = Doc.between "\"" "\""
164 type Loq = Loqualization L10n
168 CLI.HelpConstraint repr Doc =>
169 (forall lang. L10n lang => FullLocale lang -> Doc.Plain TLB.Builder) ->
171 helps f = CLI.help @_ @Doc (Doc.justify ((\(Loqualization fl) -> f fl) <$> ask))
175 class L10n_Var lang => L10n lang where
176 l10n_cli :: FullLocale lang -> Doc.Plain TLB.Builder
177 l10n_license :: FullLocale lang -> Doc.Plain TLB.Builder
178 l10n_help_version :: FullLocale lang -> Doc.Plain TLB.Builder
179 l10n_help_license :: FullLocale lang -> Doc.Plain TLB.Builder
180 l10n_help_command_source :: FullLocale lang -> Doc.Plain TLB.Builder
181 l10n_help_command_compile :: FullLocale lang -> Doc.Plain TLB.Builder
182 l10n_help_command_schema :: FullLocale lang -> Doc.Plain TLB.Builder
183 l10n_help_opt_lang :: FullLocale lang -> Doc.Plain TLB.Builder
184 l10n_help_opt_output :: FullLocale lang -> Doc.Plain TLB.Builder
185 l10n_help_opt_output_css :: FullLocale lang -> Doc.Plain TLB.Builder
186 l10n_help_opt_output_js :: FullLocale lang -> Doc.Plain TLB.Builder
187 l10n_help_opt_dump_tct :: FullLocale lang -> Doc.Plain TLB.Builder
188 l10n_help_opt_dump_xml :: FullLocale lang -> Doc.Plain TLB.Builder
189 l10n_help_opt_dump_deps :: FullLocale lang -> Doc.Plain TLB.Builder
190 l10n_help_opt_dump_dtc :: FullLocale lang -> Doc.Plain TLB.Builder
191 l10n_help_format :: FullLocale lang -> Doc.Plain TLB.Builder
192 l10n_help_format_plain :: FullLocale lang -> Doc.Plain TLB.Builder
193 l10n_help_format_html5 :: FullLocale lang -> Doc.Plain TLB.Builder
194 l10n_help_format_xml :: FullLocale lang -> Doc.Plain TLB.Builder
195 l10n_help_opt_input :: FullLocale lang -> Doc.Plain TLB.Builder
196 l10n_help_opt_help_full :: FullLocale lang -> Doc.Plain TLB.Builder
197 l10n_help_opt_help_compact :: FullLocale lang -> Doc.Plain TLB.Builder
198 l10n_help_opt_verbosity :: FullLocale lang -> Doc.Plain TLB.Builder
200 instance L10n EN where
201 l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
204 List.intercalate "\n"
205 [ "License: GNU GPLv3+"
206 , "Copyright: Julien Moutinho <julm+textphile@sourcephile.fr>"
208 , "hdoc is free software: you can redistribute it and/or modify it"
209 , "under the terms of the GNU General Public License (GPL)"
210 , "as published by the Free Software Foundation;"
211 , "either in version 3, or (at your option) any later version."
213 , "hdoc is distributed in the hope that it will be useful,"
214 , "but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY"
215 , "or FITNESS FOR A PARTICULAR PURPOSE."
217 , "See the GNU GPL for more details."
218 , "You should have received a copy of the GNU GPL along with hdoc."
219 , "If not, see: http://www.gnu.org/licenses/"
221 l10n_help_version _ = "Show the version of this program."
222 l10n_help_license _ = "Inform about the license of this program."
223 l10n_help_command_source _ = "Format the source code of a TCT document."
224 l10n_help_command_compile _ = "Compile a TCT document into a format optimized for reading."
225 l10n_help_command_schema _ = "Show in RNC (RelaxNG Compact) format the XML schema of the DTC format."
226 l10n_help_opt_lang l = mconcat
227 [ "Use the language given by "
228 , l10n_var $ l10n_var_locale l
231 l10n_help_opt_output l = mconcat
232 [ "Output document into "
233 , l10n_var $ l10n_var_file l
235 l10n_help_opt_output_css l = mconcat
236 [ "Output CSS stylesheet into "
237 , l10n_var $ l10n_var_file l
238 , " (if any), instead of incorporating it into the HTML."
240 l10n_help_opt_output_js l = mconcat
241 [ "Output JavaScript script into "
242 , l10n_var $ l10n_var_file l
243 , " (if any), instead of incorporating it into the HTML."
245 l10n_help_opt_dump_tct l = mconcat
246 [ "Dump internal TCT representation of "
247 , l10n_var $ l10n_var_file l,".tct file,"
249 , l10n_var $ l10n_var_file l,".tct.dump file."
251 l10n_help_opt_dump_xml l = mconcat
252 [ "Dump internal XML representation of "
253 , l10n_var $ l10n_var_file l,".tct file,"
255 , l10n_var $ l10n_var_file l,".xml.dump file."
257 l10n_help_opt_dump_deps l = mconcat
258 [ "Dump dependencies of ", l10n_var $ l10n_var_file l,".tct file"
259 , " in ", l10n_var $ l10n_var_file l,".deps file,"
260 , " separated by newlines."
262 l10n_help_opt_dump_dtc _ = "Dump internal representation of DTC."
263 l10n_help_opt_help_full _ = "Print a commented grammar tree to help using this program."
264 l10n_help_opt_help_compact _ = "Print an uncommented grammar tree to help using this program."
265 l10n_help_format _ = "Output format."
266 l10n_help_format_plain _ = "Output as plain text."
267 l10n_help_format_html5 _ = "Output as HTML5."
268 l10n_help_format_xml _ = "Output as XML."
269 l10n_help_opt_input l = mconcat
270 [ "Read input from ", l10n_var $ l10n_var_file l, "." ]
271 l10n_help_opt_verbosity _ =
273 \\n(default: "<>con "info"<>")"
274 instance L10n FR where
275 l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
278 List.intercalate "\n"
279 [ "Licence : GPLv3+ GNU"
280 , "Auteur : Julien Moutinho <julm+textphile@sourcephile.fr>"
282 , "textphile est un logiciel libre : vous pouvez le redistribuer et/ou le modifier"
283 , "selon les termes de la Licence Publique Générale (GPL) GNU"
284 , "telle que publiée par la Free Software Foundation ;"
285 , "en version 3, ou (à votre choix) n’importe quelle version ultérieure."
287 , "textphile est distribué dans l’espoir qu’il sera utile,"
288 , "mais SANS AUCUNE GARANTIE ; sans même la garantie implicite de COMMERCIALISATION"
289 , "ou de CONVENANCE À UN BUT PARTICULIER."
291 , "Voyez la GPL pour davantage de détails."
292 , "Vous devriez avoir reçu une copie de la GPL avec textphile."
293 , "Si non, voyez : http://www.gnu.org/licenses/"
295 l10n_help_version _ = "Affiche la version de ce logiciel."
296 l10n_help_license _ = "Informe sur la licence de ce logiciel."
297 l10n_help_command_source _ = "Lit un document TCT et écrit un rendu préservant sa syntaxe."
298 l10n_help_command_compile _ = "Compile un document TCT vers un format optimisé pour la lecture."
299 l10n_help_command_schema _ = "Affiche au format RNC (RelaxNG Compact) le schéma XML du format DTC."
300 l10n_help_opt_lang l = mconcat
301 [ "Utilise le langage indiqué par "
302 , l10n_var $ l10n_var_locale l, "." ]
303 l10n_help_opt_output l = mconcat
304 [ "Écrit dans ", l10n_var $ l10n_var_file l, "." ]
305 l10n_help_opt_output_css l = mconcat
306 [ "Écrit la feuille de style CSS dans "
307 , l10n_var $ l10n_var_file l
308 , ", au lieu de l’incorporer dans le HTML."
310 l10n_help_opt_output_js l = mconcat
311 [ "Écrit le script JavaScript dans "
312 , l10n_var $ l10n_var_file l
313 , ", au lieu de l’incorporer dans le HTML."
315 l10n_help_opt_dump_tct l = mconcat
316 [ "Écrit la représentation TCT interne de "
317 , l10n_var $ l10n_var_file l,".tct,"
319 , l10n_var $ l10n_var_file l,".tct.dump."
321 l10n_help_opt_dump_xml l = mconcat
322 [ "Écrit la représentation XML interne de "
323 , l10n_var $ l10n_var_file l,".tct,"
325 , l10n_var $ l10n_var_file l,".xml.dump."
327 l10n_help_opt_dump_deps l = mconcat
328 [ "Écrit les dépendences de ", l10n_var $ l10n_var_file l,".tct"
329 , " dans ", l10n_var $ l10n_var_file l,".deps,"
330 , " séparées par des retours à la ligne."
332 l10n_help_opt_dump_dtc _ = "Écrit la représentation interne du DTC."
333 l10n_help_opt_help_full _ = "Affiche un arbre grammatical avec commentaires pour aider à utiliser ce programme."
334 l10n_help_opt_help_compact _ = "Affiche un arbre grammatical sans commentaires pour aider à utiliser ce programme."
335 l10n_help_format _ = "Format de sortie."
336 l10n_help_format_plain _ = "Produit du texte brut."
337 l10n_help_format_html5 _ = "Produit du HTML5."
338 l10n_help_format_xml _ = "Produit du XML."
339 l10n_help_opt_input l = mconcat
340 [ "Lit depuis ", l10n_var $ l10n_var_file l, "." ]
341 l10n_help_opt_verbosity _ =
342 "Niveau de verbosité.\
343 \\n(défault : "<>con "info"<>")"
345 -- ** Class 'L10n_Var'
346 class L10n_Var lang where
347 l10n_var_file :: FullLocale lang -> Name
348 l10n_var_locale :: FullLocale lang -> Name
349 instance L10n_Var EN where
350 l10n_var_file _ = "file"
351 l10n_var_locale _ = "locale"
352 instance L10n_Var FR where
353 l10n_var_file _ = "fichier"
354 l10n_var_locale _ = "locale"