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