-----------------------------------------------------------------------------
--
-- Module      : the main for calling replaceUmlaut functions
--    with a switch for the txt and the filename
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings     #-}


module ReplaceUmlaut  where      -- must have Main (main) or Main where

import UniformBase
-- import           Uniform.Convenience.StartApp
import           Uniform.Filenames           --   ( makeExtension )
-- import           Data.Semigroup                 ( (<>) )
import           Options.Applicative.Builder
import           Options.Applicative
import           Lib.ProcTxt
import Lib.OneMDfile
-- import           Lib.ProcPandocDatei
import Lib.FileHandling

programName, progTitle :: Text
programName :: Text
programName = Text
"Umlaut in md or txt file " :: Text
progTitle :: Text
progTitle =
  Text
"replace ae, oe, and ue to umlaut (except when in nichtUmlaute.txt)" :: Text

-- to run add in .ghci -- tests/Testing.hs

main :: IO ()
main :: IO ()
main = do
  forall a. Show a => Text -> ErrIO a -> IO ()
startProg
    Text
programName
    -- progTitle
    (Text -> Text -> ErrIO ()
parseAndExecute
      ([Text] -> Text
unlinesT
        [ Text
"converts words in the file given where"
        , Text
"the umlaut is written as ae, oe and ue"
        , Text
"to regular umlaut, "
        , Text
"execpt when in file nichtUmlaute"
        , Text
"which is the list of words where ae, oe or ue must remain."
        ]
      )
      Text
"the file (with extension .txt or .md)"
    )
  forall (m :: * -> *) a. Monad m => a -> m a
return ()


--- cmd line parsing
data LitArgs = LitArgs { LitArgs -> Bool
isTxt   :: Bool   -- ^ is this a txt file
      , LitArgs -> String
argfile  :: String -- ^ the filename absolute
      } deriving (Int -> LitArgs -> ShowS
[LitArgs] -> ShowS
LitArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LitArgs] -> ShowS
$cshowList :: [LitArgs] -> ShowS
show :: LitArgs -> String
$cshow :: LitArgs -> String
showsPrec :: Int -> LitArgs -> ShowS
$cshowsPrec :: Int -> LitArgs -> ShowS
Show)

cmdArgs :: Parser (LitArgs)
cmdArgs :: Parser LitArgs
cmdArgs =
  Bool -> String -> LitArgs
LitArgs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
          (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"txt" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help
            String
"true if this is a txt file, txt or md extension is recognized"
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str
                 (
      --   long "filename" <>
                  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"filename")

parseAndExecute :: Text -> Text -> ErrIO ()
parseAndExecute :: Text -> Text -> ErrIO ()
parseAndExecute Text
t1 Text
t2 = do
        LitArgs
args <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ forall a. ParserInfo a -> IO a
execParser ParserInfo LitArgs
opts
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"parseAndExecute LitArgs", forall {a}. Show a => a -> Text
showT LitArgs
args]
        Path Abs Dir
curr <- ErrIO (Path Abs Dir)
currentDir
        -- let dir0 = makeAbsDir "/home/frank/additionalSpace/DataBig/LitOriginals"
        let fn2 :: String
fn2     = LitArgs -> String
argfile LitArgs
args :: FilePath
        let fn :: Path Abs File
fn = Path Abs Dir
curr forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> String -> Path Rel File
makeRelFile String
fn2 :: Path Abs File
        let isText :: Bool
isText  = LitArgs -> Bool
isTxt LitArgs
args :: Bool

        let ext :: ExtensionType (Path Abs File)
ext     = forall fp. Extensions fp => fp -> ExtensionType fp
getExtension Path Abs File
fn
        let isText2 :: Bool
isText2 = Bool
isText Bool -> Bool -> Bool
|| ExtensionType (Path Abs File)
ext forall a. Eq a => a -> a -> Bool
== (String -> Extension
Extension String
"txt")
        let debug :: Bool
debug   = Bool
False
        let erlFn :: Path Abs File
erlFn = String -> Path Abs File
makeAbsFile String
"/home/frank/Workspace8/replaceUmlaut/nichtUmlaute.txt"
        [Text]
erl2               <- Path Abs File -> ErrIO [Text]
readErlaubt Path Abs File
erlFn
        Bool
res <- if Bool
isText2 then Bool -> [Text] -> Path Abs File -> ErrIO Bool
procTxt Bool
debug [Text]
erl2 Path Abs File
fn else Bool -> [Text] -> Path Abs File -> ErrIO Bool
procMd1 Bool
debug [Text]
erl2 Path Abs File
fn
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"parseAndExecute done. File was changed: ", forall {a}. Show a => a -> Text
showT Bool
res]
        
    where
        opts :: ParserInfo LitArgs
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LitArgs
cmdArgs)
              (forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> (forall a. String -> InfoMod a
progDesc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
t1) forall a. Semigroup a => a -> a -> a
<> (forall a. String -> InfoMod a
header forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
t2))