{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}

module Language.Lojban.Dictionaries.English
( englishDictionary
) where

import Language.Lojban.Core
import Util (subfield)
import Control.Applicative ((<$>))
import Control.Arrow (second)
import Data.Maybe (isNothing, catMaybes)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Map as M
import qualified Data.Yaml as Y
import Data.FileEmbed (embedStringFile)

-- | Dictionary in English.
englishDictionary :: Dictionary
englishDictionary :: Dictionary
englishDictionary = Text
-> Map Text Gismu
-> Map Text Cmavo
-> Map Text Brivla
-> Map Text Gismu
-> Map Text Text
-> Map Text [Text]
-> Dictionary
Dictionary Text
"english" Map Text Gismu
gismuMap Map Text Cmavo
cmavoMap Map Text Brivla
brivlaMap Map Text Gismu
rafsiMap Map Text Text
definitionsMap Map Text [Text]
englishBrivlaPlacesMap where
    -- Frequency map
    frequencyMap :: FrequencyMap
frequencyMap = Text -> FrequencyMap
loadFrequencyMapFromText (Text -> FrequencyMap) -> Text -> FrequencyMap
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack $(embedStringFile "resources/language/frequency-lists/MyFreq-COMB_without_dots.txt")
    -- Cmavo
    cmavo :: [Cmavo]
cmavo = FrequencyMap -> Text -> [Cmavo]
loadCmavoFromText FrequencyMap
frequencyMap (Text -> [Cmavo]) -> Text -> [Cmavo]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack $(embedStringFile "resources/language/dictionary-generation/english/cmavo.txt")
    cmavoList :: [(Text, Cmavo)]
cmavoList = (Cmavo -> (Text, Cmavo)) -> [Cmavo] -> [(Text, Cmavo)]
forall a b. (a -> b) -> [a] -> [b]
map (\Cmavo
c -> (Cmavo -> Text
cmavoText Cmavo
c, Cmavo
c)) [Cmavo]
cmavo
    cmavoMap :: Map Text Cmavo
cmavoMap = [(Text, Cmavo)] -> Map Text Cmavo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Cmavo)]
cmavoList
    -- Gismu
    isReallyGismu :: Gismu -> Bool
isReallyGismu Gismu
gismu = Maybe Cmavo -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Cmavo -> Bool) -> Maybe Cmavo -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Cmavo -> Maybe Cmavo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Gismu -> Text
gismuText Gismu
gismu) Map Text Cmavo
cmavoMap
    gismu :: [Gismu]
gismu = (Gismu -> Bool) -> [Gismu] -> [Gismu]
forall a. (a -> Bool) -> [a] -> [a]
filter Gismu -> Bool
isReallyGismu ([Gismu] -> [Gismu]) -> [Gismu] -> [Gismu]
forall a b. (a -> b) -> a -> b
$ FrequencyMap -> Text -> [Gismu]
loadGismuFromText FrequencyMap
frequencyMap (Text -> [Gismu]) -> Text -> [Gismu]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack $(embedStringFile "resources/language/dictionary-generation/english/gismu.txt")
    gismuList :: [(Text, Gismu)]
gismuList = (Gismu -> (Text, Gismu)) -> [Gismu] -> [(Text, Gismu)]
forall a b. (a -> b) -> [a] -> [b]
map (\Gismu
g -> (Gismu -> Text
gismuText Gismu
g, Gismu
g)) [Gismu]
gismu
    gismuMap :: Map Text Gismu
gismuMap = [(Text, Gismu)] -> Map Text Gismu
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Gismu)]
gismuList
    -- Brivla
    brivlaFromGismu :: [Brivla]
brivlaFromGismu = (Gismu -> Brivla) -> [Gismu] -> [Brivla]
forall a b. (a -> b) -> [a] -> [b]
map (\Gismu
g -> Text -> Text -> Int -> Brivla
Brivla (Gismu -> Text
gismuText Gismu
g) (Gismu -> Text
gismuEnglishDefinition Gismu
g) (Gismu -> Int
gismuIRCFrequencyCount Gismu
g)) [Gismu]
gismu
    brivlaFromFile :: [Brivla]
brivlaFromFile = FrequencyMap -> Text -> [Brivla]
loadBrivlaFromText FrequencyMap
frequencyMap (Text -> [Brivla]) -> Text -> [Brivla]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack $(embedStringFile "resources/language/dictionary-generation/english/brivla.yaml")
    brivla :: [Brivla]
brivla = [Brivla]
brivlaFromGismu [Brivla] -> [Brivla] -> [Brivla]
forall a. [a] -> [a] -> [a]
++ [Brivla]
brivlaFromFile
    brivlaList :: [(Text, Brivla)]
brivlaList = (Brivla -> (Text, Brivla)) -> [Brivla] -> [(Text, Brivla)]
forall a b. (a -> b) -> [a] -> [b]
map (\Brivla
b -> (Brivla -> Text
brivlaText Brivla
b, Brivla
b)) [Brivla]
brivla
    brivlaMap :: Map Text Brivla
brivlaMap = [(Text, Brivla)] -> Map Text Brivla
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Brivla)]
brivlaList
    -- Rafsi
    rafsiMap :: Map Text Gismu
rafsiMap = [(Text, Gismu)] -> Map Text Gismu
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Gismu)] -> Map Text Gismu)
-> ([[(Text, Gismu)]] -> [(Text, Gismu)])
-> [[(Text, Gismu)]]
-> Map Text Gismu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Text, Gismu)]] -> [(Text, Gismu)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, Gismu)]] -> Map Text Gismu)
-> [[(Text, Gismu)]] -> Map Text Gismu
forall a b. (a -> b) -> a -> b
$ (Gismu -> [(Text, Gismu)]) -> [Gismu] -> [[(Text, Gismu)]]
forall a b. (a -> b) -> [a] -> [b]
map Gismu -> [(Text, Gismu)]
extractRafsiPairsFromGismu [Gismu]
gismu
    extractRafsiPairsFromGismu :: Gismu -> [(T.Text, Gismu)]
    extractRafsiPairsFromGismu :: Gismu -> [(Text, Gismu)]
extractRafsiPairsFromGismu Gismu
g = (Text -> (Text, Gismu)) -> [Text] -> [(Text, Gismu)]
forall a b. (a -> b) -> [a] -> [b]
map (, Gismu
g) (Gismu -> [Text]
gismuRafsi Gismu
g)
    -- Definitions
    brivlaDefinitions :: [(Text, Text)]
brivlaDefinitions = ((Brivla -> Text) -> (Text, Brivla) -> (Text, Text)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Brivla -> Text
brivlaDefinition) ((Text, Brivla) -> (Text, Text))
-> [(Text, Brivla)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Brivla)]
brivlaList
    cmavoDefinitions :: [(Text, Text)]
cmavoDefinitions = ((Cmavo -> Text) -> (Text, Cmavo) -> (Text, Text)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Cmavo -> Text
cmavoEnglishDefinition) ((Text, Cmavo) -> (Text, Text))
-> [(Text, Cmavo)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Cmavo)]
cmavoList
    gismuDefinitions :: [(Text, Text)]
gismuDefinitions = ((Gismu -> Text) -> (Text, Gismu) -> (Text, Text)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Gismu -> Text
gismuEnglishDefinition) ((Text, Gismu) -> (Text, Text))
-> [(Text, Gismu)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Gismu)]
gismuList
    definitionsList :: [(Text, Text)]
definitionsList = [(Text, Text)]
cmavoDefinitions [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
gismuDefinitions [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
brivlaDefinitions
    definitionsMap :: Map Text Text
definitionsMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Text)]
definitionsList

-- Gismu
loadGismuFromLine :: FrequencyMap -> T.Text -> Gismu
loadGismuFromLine :: FrequencyMap -> Text -> Gismu
loadGismuFromLine FrequencyMap
frequencyMap Text
line =
    let text :: Text
text = Int -> Int -> Text -> Text
subfield Int
1 Int
6 Text
line
        rafsi1 :: Text
rafsi1 = Int -> Int -> Text -> Text
subfield Int
7 Int
10 Text
line
        rafsi2 :: Text
rafsi2 = Int -> Int -> Text -> Text
subfield Int
11 Int
14 Text
line
        rafsi3 :: Text
rafsi3 = Int -> Int -> Text -> Text
subfield Int
15 Int
19 Text
line
        englishBrivlaPlaces :: [Text]
englishBrivlaPlaces = Map Text [Text]
englishBrivlaPlacesMap Map Text [Text] -> Text -> [Text]
forall k a. Ord k => Map k a -> k -> a
M.! Text
text
        englishKeyword1 :: Text
englishKeyword1 = Int -> Int -> Text -> Text
subfield Int
20 Int
41 Text
line
        englishKeyword2 :: Text
englishKeyword2 = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> Text
subfield Int
41 Int
62 Text
line
        englishDefinition :: Text
englishDefinition = Int -> Int -> Text -> Text
subfield Int
62 Int
158 Text
line
        teachingCode :: Text
teachingCode = Int -> Int -> Text -> Text
subfield Int
159 Int
161 Text
line
        oldFrequencyCount :: Int
oldFrequencyCount = (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> Text
subfield Int
161 Int
165 Text
line) :: Int
        englishFullNotes :: Text
englishFullNotes = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
165 Text
line
        (Text
englishNotes, [Text]
confer) = Text -> (Text, [Text])
parseNotes Text
englishFullNotes
    in Text
-> [Text]
-> [Text]
-> [Text]
-> Text
-> Text
-> [Text]
-> Text
-> Int
-> Int
-> Gismu
Gismu Text
text ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text
rafsi1, Text
rafsi2, Text
rafsi3]) [Text]
englishBrivlaPlaces ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
T.empty) [Text
englishKeyword1, Text
englishKeyword2]) Text
englishDefinition Text
englishNotes [Text]
confer Text
teachingCode Int
oldFrequencyCount (Int -> Text -> FrequencyMap -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 Text
text FrequencyMap
frequencyMap)

loadGismuFromText :: FrequencyMap -> T.Text -> [Gismu]
loadGismuFromText :: FrequencyMap -> Text -> [Gismu]
loadGismuFromText FrequencyMap
frequencyMap = (Text -> Gismu) -> [Text] -> [Gismu]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FrequencyMap -> Text -> Gismu
loadGismuFromLine FrequencyMap
frequencyMap) ([Text] -> [Gismu]) -> (Text -> [Text]) -> Text -> [Gismu]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- Cmavo
loadCmavoFromLine :: FrequencyMap -> T.Text -> Cmavo
loadCmavoFromLine :: FrequencyMap -> Text -> Cmavo
loadCmavoFromLine FrequencyMap
frequencyMap Text
line =
    let text :: Text
text = Int -> Int -> Text -> Text
subfield Int
0 Int
11 Text
line
        englishClassification :: Text
englishClassification = Int -> Int -> Text -> Text
subfield Int
11 Int
20 Text
line
        englishKeyword :: Text
englishKeyword = Int -> Int -> Text -> Text
subfield Int
20 Int
62 Text
line
        englishDefinition :: Text
englishDefinition = Int -> Int -> Text -> Text
subfield Int
62 Int
168 Text
line
        englishFullNotes :: Text
englishFullNotes = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
168 Text
line
        (Text
englishNotes, [Text]
confer) = Text -> (Text, [Text])
parseNotes Text
englishFullNotes
    in Text -> Text -> Text -> Text -> Text -> [Text] -> Int -> Cmavo
Cmavo Text
text Text
englishClassification Text
englishKeyword Text
englishDefinition Text
englishNotes [Text]
confer (Int -> Text -> FrequencyMap -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 Text
text FrequencyMap
frequencyMap)

loadCmavoFromText :: FrequencyMap -> T.Text -> [Cmavo]
loadCmavoFromText :: FrequencyMap -> Text -> [Cmavo]
loadCmavoFromText FrequencyMap
frequencyMap = (Text -> Cmavo) -> [Text] -> [Cmavo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FrequencyMap -> Text -> Cmavo
loadCmavoFromLine FrequencyMap
frequencyMap) ([Text] -> [Cmavo]) -> (Text -> [Text]) -> Text -> [Cmavo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
tail ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- Brivla
loadBrivlaFromText :: FrequencyMap -> T.Text -> [Brivla]
loadBrivlaFromText :: FrequencyMap -> Text -> [Brivla]
loadBrivlaFromText FrequencyMap
frequencyMap Text
yamlText = ((Text, Map Text Text) -> Brivla)
-> [(Text, Map Text Text)] -> [Brivla]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Map Text Text) -> Brivla
handleBrivla [(Text, Map Text Text)]
yamlList where
    yamlData :: M.Map T.Text (M.Map T.Text T.Text)
    Right Map Text (Map Text Text)
yamlData = ByteString -> Either String (Map Text (Map Text Text))
forall a. FromJSON a => ByteString -> Either String a
Y.decodeEither (ByteString -> Either String (Map Text (Map Text Text)))
-> ByteString -> Either String (Map Text (Map Text Text))
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
yamlText
    yamlList :: [(T.Text, M.Map T.Text T.Text)]
    yamlList :: [(Text, Map Text Text)]
yamlList = Map Text (Map Text Text) -> [(Text, Map Text Text)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Text (Map Text Text)
yamlData
    handleBrivla :: (T.Text, M.Map T.Text T.Text) -> Brivla
    handleBrivla :: (Text, Map Text Text) -> Brivla
handleBrivla (Text
brivlaKey, Map Text Text
brivlaData) = Text -> Text -> Int -> Brivla
Brivla Text
brivlaKey (Map Text Text
brivlaData Map Text Text -> Text -> Text
forall k a. Ord k => Map k a -> k -> a
M.! Text
"definition") (FrequencyMap
frequencyMap FrequencyMap -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Text
brivlaKey)

-- Brivla places
englishBrivlaPlacesMap :: M.Map T.Text [T.Text]
englishBrivlaPlacesMap :: Map Text [Text]
englishBrivlaPlacesMap = Text -> Map Text [Text]
loadBrivlaPlacesMapFromYaml (Text -> Map Text [Text]) -> Text -> Map Text [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack $(embedStringFile "resources/language/dictionary-generation/english/brivla-places.yaml")

loadBrivlaPlacesMapFromYaml :: T.Text -> M.Map T.Text [T.Text]
loadBrivlaPlacesMapFromYaml :: Text -> Map Text [Text]
loadBrivlaPlacesMapFromYaml Text
yamlText = (Map Text Text -> [Text])
-> Map Text (Map Text Text) -> Map Text [Text]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Map Text Text -> [Text]
extractPlaces Map Text (Map Text Text)
yamlData where
    yamlData :: M.Map T.Text (M.Map T.Text T.Text)
    Right Map Text (Map Text Text)
yamlData = ByteString -> Either String (Map Text (Map Text Text))
forall a. FromJSON a => ByteString -> Either String a
Y.decodeEither (ByteString -> Either String (Map Text (Map Text Text)))
-> ByteString -> Either String (Map Text (Map Text Text))
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
yamlText
    extractPlaces :: M.Map T.Text T.Text -> [T.Text]
    extractPlaces :: Map Text Text -> [Text]
extractPlaces Map Text Text
dict = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ Map Text Text
dict Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
"x1" , Map Text Text
dict Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
"x2", Map Text Text
dict Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
"x3", Map Text Text
dict Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
"x4", Map Text Text
dict Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
"x5" ]

-- Helper functions
parseNotes :: T.Text -> (T.Text, [T.Text])
parseNotes :: Text -> (Text, [Text])
parseNotes Text
englishFullNotes =
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"(cf. " Text
englishFullNotes of
        Text
englishNotes:Text
confer':[Text]
_ -> (Text
englishNotes, (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isSingleWord ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
", " (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
confer')
        Text
englishNotes:[Text]
_ -> (Text
englishNotes, [])
    where
        isSingleWord :: T.Text -> Bool
        isSingleWord :: Text -> Bool
isSingleWord Text
x = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.words Text
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

-- Frequency map
type FrequencyMap = M.Map T.Text Int

loadFrequencyPairFromLine :: T.Text -> (T.Text, Int)
loadFrequencyPairFromLine :: Text -> (Text, Int)
loadFrequencyPairFromLine Text
line = (Text
w, String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
f) where
    [Text
f, Text
w] = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" " Text
line

loadFrequencyMapFromText :: T.Text -> FrequencyMap
loadFrequencyMapFromText :: Text -> FrequencyMap
loadFrequencyMapFromText = [(Text, Int)] -> FrequencyMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Int)] -> FrequencyMap)
-> (Text -> [(Text, Int)]) -> Text -> FrequencyMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (Text, Int)) -> [Text] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Int)
loadFrequencyPairFromLine ([Text] -> [(Text, Int)])
-> (Text -> [Text]) -> Text -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\r" Text
"") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines