]> Git — Sourcephile - doclang.git/blob - cli/Textphile/CLI/Lang.hs
stack: add stack.yaml.lock
[doclang.git] / cli / Textphile / CLI / Lang.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Textphile.CLI.Lang where
5
6 import Control.Applicative (Applicative(..), (<*), liftA2, liftA3)
7 import Control.Monad.Trans.Reader (Reader, runReader, ReaderT, runReaderT, ask)
8 import Data.Bool
9 import Data.Eq (Eq(..))
10 import Data.Function (($), (.))
11 import Data.Functor (Functor(..), (<$>))
12 import Data.Locale
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
28
29 type Doc = Reader Loq (Doc.Plain TLB.Builder)
30
31 instance (Semigroup d, Applicative m) => Semigroup (ReaderT r m (Doc.Plain d)) where
32 (<>) = liftA2 (<>)
33 instance (Monoid d, Applicative m) => Monoid (ReaderT r m (Doc.Plain d)) where
34 mempty = pure mempty
35 mappend = liftA2 mappend
36 instance
37 ( Doc.From (Doc.Word String) d
38 , Applicative m
39 , Doc.Spaceable d
40 ) => IsString (ReaderT r m (Doc.Plain d)) where
41 fromString = pure . fromString
42 instance
43 ( Applicative m
44 , Doc.Spaceable d
45 ) => Doc.Spaceable (ReaderT r m (Doc.Plain d)) where
46 newline = pure Doc.newline
47 space = pure Doc.space
48 instance
49 ( Functor m
50 , Semigroup d
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
55 red = fmap Doc.red
56 green = fmap Doc.green
57 yellow = fmap Doc.yellow
58 blue = fmap Doc.blue
59 magenta = fmap Doc.magenta
60 cyan = fmap Doc.cyan
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
86 instance
87 ( Applicative m
88 , Semigroup d
89 , Doc.From [Doc.SGR] d
90 ) => Doc.Decorable (ReaderT r m (Doc.Plain d)) where
91 bold = fmap Doc.bold
92 underline = fmap Doc.underline
93 italic = fmap Doc.italic
94 instance
95 ( Applicative m
96 , Semigroup d
97 , Doc.Spaceable d
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
104 instance
105 ( Applicative m
106 , Semigroup d
107 , Doc.Spaceable d
108 ) => Doc.Justifiable (ReaderT r m (Doc.Plain d)) where
109 justify = fmap Doc.justify
110 instance
111 ( Applicative m
112 , Semigroup d
113 , Doc.Spaceable d
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)
120 instance
121 ( Applicative m
122 , Semigroup d
123 , Doc.Lengthable s
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
131
132 instance IOType Doc
133 instance Outputable Doc where
134 output d = do
135 lang <- getLang
136 output $ runReader d $ loqualize lang
137 instance Outputable (OnHandle Doc) where
138 output (OnHandle h d) = do
139 lang <- getLang
140 output $ OnHandle h $ runReader d $ loqualize lang
141
142 getLang :: IO Lang
143 getLang =
144 (\v -> Map.findWithDefault
145 (LocaleIn @Langs en_US)
146 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
147 (locales @Langs)) .
148 fromMaybe ""
149 <$> Env.lookupEnv "LANG"
150
151 type Name = Text
152
153 -- * Type 'Lang'
154 -- | Supported locales
155 type Langs = '[FR, EN]
156 type Lang = LocaleIn Langs
157
158 l10n_var v = "<"<>Doc.from v<>">"
159 ref = Doc.underline
160 con = Doc.between "\"" "\""
161 fileRef = ref
162
163 -- ** Class 'L10n'
164 type Loq = Loqualization L10n
165
166 helps ::
167 CLI.CLI_Help repr =>
168 CLI.HelpConstraint repr Doc =>
169 (forall lang. L10n lang => FullLocale lang -> Doc.Plain TLB.Builder) ->
170 repr f k -> repr f k
171 helps f = CLI.help @_ @Doc (Doc.justify ((\(Loqualization fl) -> f fl) <$> ask))
172 infixr 0 `helps`
173
174 -- | Localization
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
199
200 instance L10n EN where
201 l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
202 l10n_license _ =
203 fromString $
204 List.intercalate "\n"
205 [ "License: GNU GPLv3+"
206 , "Copyright: Julien Moutinho <julm+textphile@sourcephile.fr>"
207 , ""
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."
212 , ""
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."
216 , ""
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/"
220 ]
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
229 , "."
230 ]
231 l10n_help_opt_output l = mconcat
232 [ "Output document into "
233 , l10n_var $ l10n_var_file l
234 ]
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."
239 ]
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."
244 ]
245 l10n_help_opt_dump_tct l = mconcat
246 [ "Dump internal TCT representation of "
247 , l10n_var $ l10n_var_file l,".tct file,"
248 , " in a"
249 , l10n_var $ l10n_var_file l,".tct.dump file."
250 ]
251 l10n_help_opt_dump_xml l = mconcat
252 [ "Dump internal XML representation of "
253 , l10n_var $ l10n_var_file l,".tct file,"
254 , " in a"
255 , l10n_var $ l10n_var_file l,".xml.dump file."
256 ]
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."
261 ]
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 _ =
272 "Verbosity level.\
273 \\n(default: "<>con "info"<>")"
274 instance L10n FR where
275 l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
276 l10n_license _ =
277 fromString $
278 List.intercalate "\n"
279 [ "Licence : GPLv3+ GNU"
280 , "Auteur : Julien Moutinho <julm+textphile@sourcephile.fr>"
281 , ""
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."
286 , ""
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."
290 , ""
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/"
294 ]
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."
309 ]
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."
314 ]
315 l10n_help_opt_dump_tct l = mconcat
316 [ "Écrit la représentation TCT interne de "
317 , l10n_var $ l10n_var_file l,".tct,"
318 , " dans "
319 , l10n_var $ l10n_var_file l,".tct.dump."
320 ]
321 l10n_help_opt_dump_xml l = mconcat
322 [ "Écrit la représentation XML interne de "
323 , l10n_var $ l10n_var_file l,".tct,"
324 , " dans "
325 , l10n_var $ l10n_var_file l,".xml.dump."
326 ]
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."
331 ]
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"<>")"
344
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"