{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Lib.ProcWord
where
import UniformBase
import qualified Data.Text as T (commonPrefixes)
import Control.Monad.Trans.Writer.Strict
procLine2 :: [Text] -> Text -> Text
procLine2 :: [Text] -> Text -> Text
procLine2 [Text]
erl2 Text
t = Text
ld forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text -> Text
procLine [Text]
erl2 Text
t1)
where
(Text
ld, Text
t1) = Text -> (Text, Text)
auxProcLine2 Text
t
auxProcLine2 :: Text -> (Text,Text)
auxProcLine2 :: Text -> (Text, Text)
auxProcLine2 Text
t = case Text -> Maybe (Text, Text, Text)
mb1 Text
t of
Maybe (Text, Text, Text)
Nothing -> case Text -> Maybe (Text, Text, Text)
mb2 Text
t of
Maybe (Text, Text, Text)
Nothing -> (Text
"", Text
t)
Just (Text
lead2, Text
_, Text
t02) -> (Text
lead2,Text
t02)
Just (Text
lead, Text
_, Text
t0) -> (Text
lead,Text
t0)
where
mb1 :: Text -> Maybe (Text, Text, Text)
mb1 Text
tx = Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
" " Text
tx
mb2 :: Text -> Maybe (Text, Text, Text)
mb2 Text
ty = Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
"\t\t\t\t\t\t\t" Text
ty
procLine2Rep :: [Text] -> Text -> Writer Text Text
procLine2Rep :: [Text] -> Text -> Writer Text Text
procLine2Rep [Text]
erl2 Text
t = do
Text
t2 <- [Text] -> Text -> Writer Text Text
procLineRep [Text]
erl2 Text
t1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
ld forall a. Semigroup a => a -> a -> a
<> Text
t2
where (Text
ld,Text
t1) = Text -> (Text, Text)
auxProcLine2 Text
t
procLine :: [Text] -> Text -> Text
procLine :: [Text] -> Text -> Text
procLine [Text]
erlaubt Text
ln = forall a. CharChains a => [a] -> a
unwords' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text -> Text
procWord2 [Text]
erlaubt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> [a]
words' forall a b. (a -> b) -> a -> b
$ Text
ln
procLineRep :: [Text] -> Text -> Writer Text Text
procLineRep :: [Text] -> Text -> Writer Text Text
procLineRep [Text]
erlaubt Text
ln = do
[Text]
ln2rep <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Text] -> Text -> Writer Text Text
procWord2Rep [Text]
erlaubt) (forall a. CharChains a => a -> [a]
words' Text
ln)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords' forall a b. (a -> b) -> a -> b
$ [Text]
ln2rep
procWord2 :: [Text] -> Text -> Text
procWord2 :: [Text] -> Text -> Text
procWord2 [Text]
erlaubt Text
word =
if [Text] -> Text -> Bool
checkErlaubt [Text]
erlaubt Text
word then Text
word else Text -> Text
procWord1 Text
word
procWord2Rep :: [Text] -> Text -> Writer Text Text
procWord2Rep :: [Text] -> Text -> Writer Text Text
procWord2Rep [Text]
erlaubt Text
word = do
let word1 :: Text
word1 = [Text] -> Text -> Text
procWord2 [Text]
erlaubt Text
word
if Text
word1 forall a. Eq a => a -> a -> Bool
== Text
word
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
word
else do
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ((Text
word1forall a. Semigroup a => a -> a -> a
<>Text
" ")::Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Text
word1
procWord1 :: Text -> Text
procWord1 :: Text -> Text
procWord1 Text
t =
forall a. CharChains a => a -> a -> a -> a
replace' Text
"AE" Text
"Ä"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"OE" Text
"Ö"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"UE" Text
"Ü"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"Ae" Text
"Ä"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"Oe" Text
"Ö"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"Ue" Text
"Ü"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"ae" Text
"ä"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"oe" Text
"ö"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> a -> a
replace' Text
"ue" Text
"ü"
forall a b. (a -> b) -> a -> b
$ Text
t
erlaubt1 :: [Text]
erlaubt1 :: [Text]
erlaubt1 = forall a b. (a -> b) -> [a] -> [b]
map forall a. CharChains a => a -> a
toLower' [Text
"koef", Text
"poet", Text
"poes", Text
"neue", Text
"freue"]
checkErlaubt :: [Text] -> Text -> Bool
checkErlaubt :: [Text] -> Text -> Bool
checkErlaubt [Text]
erlaubt Text
word = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
e -> forall a. CharChains a => a -> a -> Bool
isInfixOf' Text
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
toLower' forall a b. (a -> b) -> a -> b
$ Text
word) [Text]
erlaubt
checkErlaubt1 :: Text -> Bool
checkErlaubt1 :: Text -> Bool
checkErlaubt1 = [Text] -> Text -> Bool
checkErlaubt [Text]
erlaubt1