{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Owoifier ( owoify
, weakOwoify
) where
import qualified Data.Text as T
owolessDelim :: T.Text
owolessDelim :: Text
owolessDelim = Text
"```"
alternate :: (a -> a) -> [a] -> [a]
alternate :: (a -> a) -> [a] -> [a]
alternate a -> a
f = ((a -> a) -> a -> a) -> [a -> a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) ([a -> a] -> [a -> a]
forall a. [a] -> [a]
cycle [a -> a
f, a -> a
forall a. a -> a
id])
owoify :: T.Text -> T.Text
owoify :: Text -> Text
owoify Text
text = Text -> [Text] -> Text
T.intercalate Text
owolessDelim ((Text -> Text) -> [Text] -> [Text]
forall a. (a -> a) -> [a] -> [a]
alternate Text -> Text
owoifySegment [Text]
segments) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" owo"
where segments :: [Text]
segments = Text -> Text -> [Text]
T.splitOn Text
owolessDelim Text
text
owoifySegment :: T.Text -> T.Text
owoifySegment :: Text -> Text
owoifySegment = Text -> Text
doInserts (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
weakOwoify
weakOwoify :: T.Text -> T.Text
weakOwoify :: Text -> Text
weakOwoify = (Char -> Char) -> Text -> Text
T.map Char -> Char
owoifyChar
owoifyChar :: Char -> Char
owoifyChar :: Char -> Char
owoifyChar Char
c
| Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"LR" :: [Char]) = Char
'W'
| Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"lr" :: [Char]) = Char
'w'
| Bool
otherwise = Char
c
(<->) :: [Char] -> [Char] -> [T.Text]
<-> :: [Char] -> [Char] -> [Text]
(<->) [Char]
as [Char]
bs = [[Char] -> Text
T.pack [Char
a,Char
b] | Char
a <- [Char]
as, Char
b <- [Char]
bs]
segmentsSmallY :: [T.Text]
segmentsSmallY :: [Text]
segmentsSmallY = [Char]
"NMnm" [Char] -> [Char] -> [Text]
<-> [Char]
"o" [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Char]
"nm" [Char] -> [Char] -> [Text]
<-> [Char]
"O"
segmentsBigY :: [T.Text]
segmentsBigY :: [Text]
segmentsBigY = [Char]
"NM" [Char] -> [Char] -> [Text]
<-> [Char]
"O"
mkRules :: [(Char, [T.Text])] -> [(T.Text, Char)]
mkRules :: [(Char, [Text])] -> [(Text, Char)]
mkRules [(Char, [Text])]
defs = do
(Char
sym, [Text]
segments) <- [(Char, [Text])]
defs
(, Char
sym) (Text -> (Text, Char)) -> [Text] -> [(Text, Char)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
segments
insertionRules :: [(T.Text, Char)]
insertionRules :: [(Text, Char)]
insertionRules = [(Char, [Text])] -> [(Text, Char)]
mkRules
[ (Char
'y', [Text]
segmentsSmallY)
, (Char
'Y', [Text]
segmentsBigY)
]
applyRule :: (T.Text, Char) -> T.Text -> T.Text
applyRule :: (Text, Char) -> Text -> Text
applyRule (Text, Char)
rule
= let (Text
word, Char
ins) = (Text, Char)
rule
newWord :: Text
newWord = Char -> Text -> Text
T.intersperse Char
ins Text
word in
Text -> Text -> Text -> Text
T.replace Text
word Text
newWord
doInserts :: T.Text -> T.Text
doInserts :: Text -> Text
doInserts Text
str = (Text -> (Text, Char) -> Text) -> Text -> [(Text, Char)] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Text, Char) -> Text -> Text) -> Text -> (Text, Char) -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text, Char) -> Text -> Text
applyRule) Text
str [(Text, Char)]
insertionRules