]> Git — Sourcephile - doclang.git/blob - cli/Textphile/CLI/Source.hs
Fix megaparsec-8 update
[doclang.git] / cli / Textphile / CLI / Source.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE StrictData #-}
4 {-# OPTIONS_GHC -Wno-missing-signatures #-}
5 module Textphile.CLI.Source where
6
7 import Control.Applicative (Applicative(..), Alternative(..))
8 import Control.Monad (Monad(..), forM_, unless, when)
9 import Control.Monad.Trans.Except (runExcept)
10 import Control.Monad.Trans.Maybe (MaybeT(..))
11 import Control.Monad.Trans.State.Strict (runState)
12 import Data.Bool
13 import Data.Either (Either(..))
14 import Data.Eq (Eq(..))
15 import Data.Foldable as Foldable (Foldable(..))
16 import Data.Function (($), (.), id, flip)
17 import Data.Functor ((<$>))
18 import Data.Maybe (Maybe(..), fromMaybe)
19 import Data.Ord (Ord(..))
20 import Data.Proxy (Proxy(..))
21 import Data.Semigroup (Semigroup(..))
22 import Data.Text (Text)
23 import Prelude (error)
24 import Symantic.CLI as CLI
25 import System.FilePath ((-<.>))
26 import System.IO (IO, FilePath)
27 import Text.Show (Show(..))
28 import qualified Data.ByteString as BS
29 import qualified Data.List as List
30 import qualified Data.Text as Text
31 import qualified Data.Text.Lazy as TL
32 import qualified Data.Text.Lazy.IO as TL
33 import qualified Data.TreeSeq.Strict as Tree
34 import qualified Paths_textphile as Textphile
35 import qualified Symantic.Document as Doc
36 import qualified System.Directory as IO
37 import qualified System.Environment as Env
38 import qualified System.FilePath as FP
39 import qualified System.FilePath as FilePath
40 import qualified System.IO as IO
41 import qualified Text.Blaze.DTC as Blaze.DTC
42 import qualified Text.Blaze.HTML5 as Blaze.HTML5
43 import qualified Text.Blaze.Renderer.Utf8 as Blaze
44 import qualified Text.Blaze.Utils as Blaze
45 import qualified Text.Megaparsec as P
46 import qualified Textphile.DTC.Read.TCT as DTC
47 import qualified Textphile.DTC.Sym as DTC
48 import qualified Textphile.DTC.Write.HTML5 as DTC
49 import qualified Textphile.DTC.Write.XML as DTC
50 import qualified Textphile.TCT as TCT
51 import qualified Textphile.TCT.Write.HTML5 as TCT
52 import qualified Textphile.TCT.Write.Plain as TCT
53 import qualified Textphile.TCT.Write.XML as TCT
54 import qualified Textphile.Utils as FS
55
56 import Textphile.CLI.Lang
57 import Textphile.CLI.Utils
58
59 data Cfg_Source = Cfg_Source
60 { cfg_source_dump_tct :: Bool
61 }
62
63 api_command_source =
64 helps l10n_help_command_source $
65 command "source" $
66 (Cfg_Source
67 <$> api_dump_tct
68 )
69 <?> api_format
70 where
71 api_dump_tct =
72 flag "dump-tct"
73 api_format =
74 api_format_plain <!>
75 api_format_html5
76 api_format_plain =
77 command "plain" $
78 api_input
79 <.> response @()
80 api_format_html5 =
81 command "html5" $
82 api_input
83 <.> response @()
84 api_input =
85 helps l10n_help_opt_input $
86 var @FP.FilePath "INPUT"
87
88 run_command_source
89 cfg_global@Cfg_Global{..}
90 cfg_source@Cfg_Source{..} =
91 run_source_plain :!:
92 run_source_html5
93 where
94 run_source_tct cfg_source_input cfg_source_output = do
95 TCT.readTCT cfg_source_input >>= \case
96 Left err -> error $ show err
97 Right tct -> do
98 when cfg_source_dump_tct $
99 FS.writeFile (cfg_source_output-<.>"tct.dump") $
100 TL.pack $ Tree.prettyTrees tct
101 return tct
102 run_source_plain cfg_source_input = do
103 let cfg_source_output = cfg_source_input FilePath.<.>"txt"
104 tct <- run_source_tct cfg_source_input cfg_source_output
105 FS.writeFile cfg_source_output $
106 TCT.writePlain tct
107 run_source_html5 cfg_source_input = do
108 let cfg_source_output = cfg_source_input FilePath.<.>"html5"
109 tct <- run_source_tct cfg_source_input cfg_source_output
110 FS.withFile cfg_source_output IO.WriteMode $ \h ->
111 Blaze.renderMarkupToByteStringIO (BS.hPutStr h) $
112 TCT.writeHTML5 tct