-----------------------------------------------------------------------------
-- Module      :   Convert umlaut written as ae, oe or ue into ä, ö and ü
--              in a txt file
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE BlockArguments #-}

module Lib.ProcTextFile  -- (openMain, htf_thisModuelsTests)
                   where
-- import Uniform.Strings
-- import Uniform.TypedFile
-- import           Uniform.FileIO
-- import Uniform.Error
import           Lib.ProcWord
import UniformBase
import Lib.FileHandling
import Uniform.Pandoc (extMD)
import Control.Monad.Trans.Writer.Strict

procTextFile :: Bool -> [Text] -> Path Abs File -> ErrIO Bool
-- ^ replace umlaut unless it is an permitted group
-- in a file with extension txt or md (only!)
-- returns True if something has changed
procTextFile :: Bool -> [Text] -> Path Abs File -> ErrIO Bool
procTextFile Bool
debug [Text]
erl2 Path Abs File
fn = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"procText start", forall {a}. Show a => a -> Text
showT Path Abs File
fn]
    let fnExtension :: Extension
fnExtension = forall fp. Extensions fp => fp -> ExtensionType fp
getExtension Path Abs File
fn :: Extension

    let textLineType :: TypedFile5 Text [Text]
textLineType
          | Extension
fnExtension forall a. Eq a => a -> a -> Bool
== Extension
txtExtension = TypedFile5 Text [Text]
textlinesFile
          | Extension
fnExtension forall a. Eq a => a -> a -> Bool
== Extension
extMD = TypedFile5 Text [Text]
mdFile
          | Bool
otherwise = forall a. [Text] -> a
errorT  [Text
"ERROR: not text file - nothing done!"]

    [Text]
ls :: [Text] <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
fn TypedFile5 Text [Text]
textLineType  -- split in lines

    -- when debug $ putIOwords ["procTxt ls", showT ls]
    -- let ls2 = map (procLine2 erl2) ls
    let ([Text]
ls2,Text
report) = forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Text] -> Text -> Writer Text Text
procLine2Rep [Text]
erl2) [Text]
ls

    -- when debug $ 
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"procText ls2", forall a. CharChains a => [a] -> a
unlines' [Text]
ls2]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. CharChains a => a -> a
trim' Text
report forall a. Eq a => a -> a -> Bool
/= forall z. Zeros z => z
zero) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"\nprocText report",  Text
report, Text
"\n"]
    -- putIOwords ["procText file returned", unlines' ls]
    -- let ls3 = unwrap7 ls2 :: Text
    -- when debug $ putIOwords ["procTxt unwrap7 . ls3", showT ls3]

    let changed :: Bool
changed = forall z. Zeros z => z
zero forall a. Eq a => a -> a -> Bool
/= forall a. CharChains a => a -> a
trim' Text
report -- no report means nothing changed 
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do 
        Bool
-> Path Abs File
-> TypedFile5 Text [Text]
-> [Text]
-> ExceptT Text IO ()
writeWithBak Bool
debug Path Abs File
fn TypedFile5 Text [Text]
textLineType (  [Text]
ls2)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
True forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"procText changed file",  forall a. NiceStrings a => a -> Text
showNice Path Abs File
fn, Text
"rewritten"
            , Text
"\n if some words in the report above are not correct"
            , Text
"\n edit the file and add the form to 'doNotReplace'."]
    -- true - changed 
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"procText done,   changed: ",  forall {a}. Show a => a -> Text
showT Bool
changed]

    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

    -- if debug 
    --     then write8 fn textlinesNewFile res
    --     else do 
    --         renameToBak8 fn textLineType 
    --         write8 fn textLineType res