1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE OverloadedLists #-}
4 {-# LANGUAGE TypeApplications #-}
5 {-# LANGUAGE TypeFamilies #-}
6 {-# LANGUAGE UndecidableInstances #-}
7 {-# OPTIONS_GHC -fno-warn-orphans #-}
10 import Control.Monad (Monad(..), forM_, when)
12 import Data.Either (Either(..))
13 import Data.Eq (Eq(..))
14 import Data.Foldable (Foldable(..))
15 import Data.Function (($), (.))
16 import Data.Functor ((<$>))
18 import Data.Maybe (Maybe(..), fromMaybe)
19 import Data.Monoid (Monoid(..))
20 import Data.Ord (Ord(..))
21 import Data.Semigroup (Semigroup(..))
23 import Data.String (String)
24 import Data.Tuple (fst)
25 import GHC.Exts (IsList(..))
26 import Options.Applicative as Opt
27 import Prelude (error)
28 import System.FilePath as FilePath
29 import System.IO (IO, FilePath)
30 import Text.Show (Show(..))
31 import qualified Data.ByteString as BS
32 import qualified Data.ByteString.Lazy as BSL
33 import qualified Data.Char as Char
34 import qualified Data.List as List
35 import qualified Data.Map.Strict as Map
36 import qualified Data.Set as Set
37 import qualified Data.Text as Text
38 import qualified Data.Text.IO as Text
39 import qualified Data.Text.Lazy as TL
40 import qualified Data.Text.Lazy.Encoding as TL
41 import qualified Data.TreeSeq.Strict as Tree
42 import qualified System.Environment as Env
43 import qualified System.IO as IO
44 import qualified Text.Blaze.Renderer.Utf8 as Blaze
45 import qualified Text.Blaze.Utils as Blaze
46 import qualified Text.Megaparsec as P
49 import qualified Language.TCT as TCT
50 import qualified Language.TCT.Write.HTML5 as TCT.Write.HTML5
51 import qualified Language.TCT.Write.Plain as TCT.Write.Plain
52 import qualified Language.TCT.Write.XML as TCT.Write.XML
55 import qualified Language.DTC.Read.TCT as DTC.Read.TCT
56 import qualified Language.DTC.Sym as DTC
57 import qualified Language.DTC.Write.HTML5 as DTC.Write.HTML5
58 import qualified Language.DTC.Write.XML as DTC.Write.XML
59 import qualified Language.RNC.Write as RNC
60 import qualified Text.Blaze.DTC as Blaze.DTC
61 import qualified Text.Blaze.HTML5 as Blaze.HTML5
63 type Langs = '[FR, EN]
64 type Lang = LocaleIn Langs
69 (\v -> Map.findWithDefault
70 (LocaleIn @Langs en_US)
71 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
74 <$> Env.lookupEnv "LANG"
75 cmd <- execParser $ pArgv lang
79 info (pCommand lang <**> helper) $ mconcat
81 , progDesc "document tool"
82 , header "hdoc - command line tool for TCT and DTC technical documents"
85 mainWithCommand :: Command -> IO ()
86 mainWithCommand (CommandTCT ArgsTCT{..}) = do
87 TCT.readTCT input >>= \case
88 Left err -> error $ show err
90 when (DumpTCT_TCT`elem`dump) $
91 writeFile (output`FilePath.replaceExtension`".tct.dump") $
92 TL.pack $ Tree.prettyTrees tct
93 when (DumpTCT_XML`elem`dump) $
94 let xml = TCT.Write.XML.document tct in
95 writeFile (output`FilePath.replaceExtension`".xml.dump") $
96 TL.pack $ Tree.prettyTrees xml
100 TCT.Write.Plain.document tct
102 withFile output IO.WriteMode $ \h ->
103 Blaze.renderMarkupToByteStringIO (BS.hPutStr h) $
104 TCT.Write.HTML5.document tct
105 mainWithCommand (CommandDTC ArgsDTC{..}) =
106 TCT.readTCT input >>= \case
107 Left err -> error $ show err
109 when (DumpDTC_TCT`elem`dump) $ do
110 writeFile (input`FilePath.replaceExtension`".tct.dump") $
111 TL.pack $ Tree.prettyTrees tct
112 let xml = TCT.Write.XML.document tct
113 when (DumpDTC_XML`elem`dump) $ do
114 writeFile (input`FilePath.replaceExtension`".xml.dump") $
115 TL.pack $ Tree.prettyTrees xml
116 case DTC.Read.TCT.readDTC xml of
117 Left err -> error $ P.parseErrorPretty err
119 when (DumpDTC_DTC`elem`dump) $ do
120 writeFile (input`FilePath.replaceExtension`".dtc.dump") $
124 withFile output IO.WriteMode $ \h ->
125 Blaze.prettyMarkupIO Blaze.DTC.isInlinedElement (BS.hPutStr h) $
126 DTC.Write.XML.document locale dtc
128 withFile output IO.WriteMode $ \h ->
129 Blaze.prettyMarkupIO Blaze.HTML5.isInlinedElement (BS.hPutStr h) $
130 DTC.Write.HTML5.document locale dtc
131 mainWithCommand (CommandRNC ArgsRNC{}) =
132 forM_ DTC.schema $ \rule ->
133 Text.hPutStrLn IO.stdout $ RNC.renderWriter rule
135 -- * Filesystem utilities
136 writeFile :: FilePath -> TL.Text -> IO ()
137 writeFile fp s = BSL.writeFile fp $ TL.encodeUtf8 s
139 withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
140 withFile = IO.withFile
142 -- * Options utilities
143 instance IsList (Opt.Mod f a) where
144 type Item (Opt.Mod f a) = Opt.Mod f a
148 readList :: [(String, a)] -> ReadM a
151 case s`List.lookup`m of
154 "cannot parse value \"" <> s
155 <> "\"\nexpecting one of: "
156 <> List.intercalate ", " (fst <$> m)
164 pCommand :: Lang -> Parser Command
169 info (CommandTCT <$> pArgsTCT) $
170 progDesc "TCT (Texte Convivial Technique) rendition."
175 info (CommandDTC <$> pArgsDTC lang) $
176 progDesc "DTC (Document Technique Convivial) rendition."
181 info (CommandRNC <$> pArgsRNC) $
182 progDesc "RNC (RelaxNG Compact) schema."
185 pDump :: Ord a => [(String, a)] -> Parser (Set a)
190 (Set.singleton <$> readList formats)
192 , help $ "Dump an intermediate format. (choices: "
193 <> List.intercalate ", " (fst <$> formats) <> ")"
201 , format :: FormatTCT
202 , dump :: Set DumpTCT
205 pArgsTCT :: Parser ArgsTCT
209 <$> argument str (metavar "FILE")
210 <*> strOption [ long "output"
213 , help "write output to FILE"
216 <*> pDump [ ("tct", DumpTCT_TCT)
217 , ("xml", DumpTCT_XML) ]
219 setDefault a@ArgsTCT{..}
220 | null output = (a::ArgsTCT){output=input`FilePath.replaceExtension`ext format}
223 FormatTCT_Plain -> ".txt"
224 FormatTCT_HTML5 -> ".html"
226 -- *** Type 'FormatTCT'
231 pFormatTCT :: Parser FormatTCT
233 flag FormatTCT_Plain FormatTCT_Plain
235 , help "Render as plain text."
237 flag FormatTCT_HTML5 FormatTCT_HTML5
239 , help "Render as HTML5."
242 -- *** Type 'DumpTCT'
246 deriving (Eq, Ord, Show)
253 , format :: FormatDTC
255 , dump :: Set DumpDTC
257 pArgsDTC :: Lang -> Parser ArgsDTC
261 <$> argument str (metavar "FILE")
262 <*> strOption [ long "output"
265 , help "write output to FILE"
269 <*> pDump [ ("tct", DumpDTC_TCT)
270 , ("xml", DumpDTC_XML)
271 , ("dtc", DumpDTC_DTC) ]
273 setDefault a@ArgsDTC{..}
274 | null output = (a::ArgsDTC){output=input`FilePath.replaceExtension`fmt format}
277 FormatDTC_XML -> ".xml"
278 FormatDTC_HTML5 -> ".html"
280 pLocale :: Lang -> Parser (LocaleIn Langs)
283 (maybeReader $ \s -> Map.lookup (Text.pack s) $ locales @Langs)
291 -- *** Type 'FormatDTC'
296 pFormatDTC :: Parser FormatDTC
298 flag FormatDTC_HTML5 FormatDTC_HTML5
300 , help "Render as HTML5."
302 flag FormatDTC_HTML5 FormatDTC_XML
304 , help "Render as XML."
307 -- *** Type 'DumpDTC'
312 deriving (Eq, Ord, Show)
318 pArgsRNC :: Parser ArgsRNC
319 pArgsRNC = pure ArgsRNC