-----------------------------------------------------------------------------
-- Module      :   Convert umlaut written as ae, oe or ue into ä, ö and ü
--              in a single word
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
                -- -fno-warn-missing-signatures
            -- -fno-warn-missing-methods 
            
module Lib.FileHandling  -- (openMain, htf_thisModuelsTests)
                    where
import UniformBase
-- import           Uniform.Strings
-- import           Uniform.FileIO
import Uniform.Pandoc (extMD)

textlinesFile :: TypedFile5 Text [Text]
-- txtFile = makeTyped txtExtension
textlinesFile :: TypedFile5 Text [Text]
textlinesFile = forall a b. TypedFiles5 a b => Extension -> TypedFile5 a b
makeTyped Extension
txtExtension
textlinesNewFile :: TypedFile5 Text [Text]
textlinesNewFile :: TypedFile5 Text [Text]
textlinesNewFile = forall a b. TypedFiles5 a b => Extension -> TypedFile5 a b
makeTyped Extension
newExtension 
textlinesBakFile :: TypedFile5 Text [Text]
textlinesBakFile :: TypedFile5 Text [Text]
textlinesBakFile = forall a b. TypedFiles5 a b => Extension -> TypedFile5 a b
makeTyped Extension
bakExtension 

mdFile :: TypedFile5 Text [Text]
mdFile :: TypedFile5 Text [Text]
mdFile = forall a b. TypedFiles5 a b => Extension -> TypedFile5 a b
makeTyped Extension
extMD

txtExtension :: Extension
txtExtension :: Extension
txtExtension = FilePath -> Extension
Extension FilePath
"txt" :: Extension
newExtension :: Extension
newExtension :: Extension
newExtension = FilePath -> Extension
Extension FilePath
"new" :: Extension
bakExtension :: Extension
bakExtension :: Extension
bakExtension = FilePath -> Extension
Extension FilePath
"bak" :: Extension
-- ^ filetype to read text in lines

-- changeExtensionBakOrNew :: Bool -> Path Abs File -> ErrIO (Extension, Path Abs File, Path Abs File)
-- -- ^ the given fn is split in extension and 
-- -- returns the bak and the new file name  
-- changeExtensionBakOrNew debug fn = do
--     let fnNaked = makeAbsFile $ getParentDir fn </> getNakedFileName fn :: Path Abs File
--     let fnExtension = getExtension fn :: Extension
--     when debug $ putIOwords ["changeExtensionBakOrNew fnNaked", showT fnNaked, "fnExtension", showT fnExtension]
 
--     let fnbak = fnNaked <.> bakExtension :: Path Abs File
--     let fnnew = fnNaked <.> newExtension :: Path Abs File

--     putIOwords ["changeExtensionBakOrNew fnbak", showT fnbak]
--     putIOwords ["changeExtensionBakOrNew fnnew", showT fnnew]
    
--     return (fnExtension, fnbak, fnnew)

instance TypedFiles7 Text [Text] where  -- creates sequence of lines
  wrap7 :: Text -> [Text]
wrap7 Text
t = forall a. CharChains a => a -> [a]
lines' Text
t  
  unwrap7 :: [Text] -> Text
unwrap7 [Text]
t = forall a. CharChains a => [a] -> a
unlines' [Text]
t 

readErlaubt :: Path Abs File -> ErrIO [Text]
-- read the erlaubte words wtih ae, oe and ue
readErlaubt :: Path Abs File -> ErrIO [Text]
readErlaubt Path Abs File
fnErl = do
  [Text]
erl :: [Text] <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
fnErl TypedFile5 Text [Text]
textlinesFile -- reads lines
  let erl2 :: [Text]
erl2 =  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. CharChains a => a -> [a]
words' forall a b. (a -> b) -> a -> b
$ [Text]
erl :: [Text]
  forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
erl2

writeWithBak :: Bool -> Path Abs File -> TypedFile5 Text [Text]-> [Text] -> ErrIO () 
-- ^ write the text into a file; use path given after renaming the file to bak
--      if debug then write the text into a new file
writeWithBak :: Bool
-> Path Abs File -> TypedFile5 Text [Text] -> [Text] -> ErrIO ()
writeWithBak Bool
debug Path Abs File
fn TypedFile5 Text [Text]
textLineType [Text]
res = 
    if Bool
debug 
        then forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ErrIO ()
write8 Path Abs File
fn TypedFile5 Text [Text]
textlinesNewFile [Text]
res
        else do 
            forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO ()
renameToBak8 Path Abs File
fn TypedFile5 Text [Text]
textLineType 
            forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ErrIO ()
write8 Path Abs File
fn TypedFile5 Text [Text]
textLineType [Text]
res