{-# LANGUAGE NoImplicitPrelude #-}
module Data.Aviation.Casa.AbbreviationsAndAcronyms.Render(
renderHeader
, renderAcronym
, renderAcronyms
, renderHeaderAcronyms
) where
import Control.Applicative(pure)
import Control.Category((.))
import Control.Lens((^.), transform)
import Control.Monad((>>=))
import Data.Align(Semialign(alignWith))
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Acronym
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Config(ConfigReader, readHeadingSeparatorColours, readSeparatorSpacing, readHeadingNameColours, readNameSpacing, readHeadingMeaningColours, readMeaningSpacing, readHeadingSourceColours, readSourceSpacing, readHeadingScoreColours, readScoreSpacing, readAcronymSeparatorColours, readAcronymNameColours, readAcronymMeaningColours, readAcronymSourceColours, readAcronymScoreColours)
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Score(HasShowScore(showScore))
import Data.Aviation.Casa.AbbreviationsAndAcronyms.Render.Spacing(nameHeader, meaningHeader, sourceHeader, scoreHeader)
import Data.Int(Int)
import Data.Foldable(toList, length)
import Data.Function(($))
import Data.Functor((<$>))
import Data.List(intercalate, replicate, (++), concat, take, splitAt)
import Data.List.NonEmpty(NonEmpty, (<|))
import Data.String(String)
import Data.These(These(This, That, These))
import Data.Traversable(Traversable(traverse))
import Prelude((-))
renderHeader ::
ConfigReader String
=
do String -> String
chc <- ConfigReader (String -> String)
readHeadingSeparatorColours
Int
shc <- ConfigReader Int
readSeparatorSpacing
String -> String
chn <- ConfigReader (String -> String)
readHeadingNameColours
Int
shn <- ConfigReader Int
readNameSpacing
String -> String
chm <- ConfigReader (String -> String)
readHeadingMeaningColours
Int
shm <- ConfigReader Int
readMeaningSpacing
String -> String
chs <- ConfigReader (String -> String)
readHeadingSourceColours
Int
shs <- ConfigReader Int
readSourceSpacing
String -> String
chr <- ConfigReader (String -> String)
readHeadingScoreColours
Int
shr <- ConfigReader Int
readScoreSpacing
String -> ConfigReader String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ConfigReader String)
-> ([String] -> String) -> [String] -> ConfigReader String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (String -> String
chc (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shc Char
'|')) ([String] -> ConfigReader String)
-> [String] -> ConfigReader String
forall a b. (a -> b) -> a -> b
$
[
String -> String
chn (Int -> String -> String
spaceN Int
shn String
nameHeader)
, String -> String
chm (Int -> String -> String
spaceN Int
shm String
meaningHeader)
, String -> String
chs (Int -> String -> String
spaceN Int
shs String
sourceHeader)
, String -> String
chr (Int -> String -> String
spaceN Int
shr String
scoreHeader)
]
renderAcronym ::
(HasShowScore a, HasAcronym a) =>
a
-> ConfigReader String
renderAcronym :: a -> ConfigReader String
renderAcronym a
a =
let name' :: String
name' =
String -> String
escapeChars (a
a a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall c_a8nA. HasAcronym c_a8nA => Lens' c_a8nA String
name)
meaning' :: String
meaning' =
String -> String
escapeChars (a
a a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall c_a8nA. HasAcronym c_a8nA => Lens' c_a8nA String
meaning)
source' :: String
source' =
String -> String
escapeChars (a
a a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall c_a8nA. HasAcronym c_a8nA => Lens' c_a8nA String
source)
score' :: String
score' =
a
a a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall a. HasShowScore a => Getter a String
showScore
spacesplit :: Int -> String -> [String]
spacesplit Int
n String
x =
NonEmpty String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty String -> [String]) -> NonEmpty String -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
spaceN Int
n (String -> String) -> NonEmpty String -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> NonEmpty String
splitEvery Int
n String
x
in do String -> String
chc <- ConfigReader (String -> String)
readAcronymSeparatorColours
Int
shc <- ConfigReader Int
readSeparatorSpacing
String -> String
chn <- ConfigReader (String -> String)
readAcronymNameColours
Int
shn <- ConfigReader Int
readNameSpacing
String -> String
chm <- ConfigReader (String -> String)
readAcronymMeaningColours
Int
shm <- ConfigReader Int
readMeaningSpacing
String -> String
chs <- ConfigReader (String -> String)
readAcronymSourceColours
Int
shs <- ConfigReader Int
readSourceSpacing
String -> String
chr <- ConfigReader (String -> String)
readAcronymScoreColours
Int
shr <- ConfigReader Int
readScoreSpacing
let name'' :: [String]
name'' =
Int -> String -> [String]
spacesplit Int
shn String
name'
meaning'' :: [String]
meaning'' =
Int -> String -> [String]
spacesplit Int
shm String
meaning'
source'' :: [String]
source'' =
Int -> String -> [String]
spacesplit Int
shs String
source'
score'' :: [String]
score'' =
Int -> String -> [String]
spacesplit Int
shr String
score'
alignWidth ::
Semialign f =>
(String -> String -> a)
-> f String
-> f String
-> String
-> String
-> f a
alignWidth :: (String -> String -> a)
-> f String -> f String -> String -> String -> f a
alignWidth String -> String -> a
k f String
m f String
n String
ms String
ns =
(These String String -> a) -> f String -> f String -> f a
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith
(\These String String
t -> case These String String
t of
This String
a1 ->
String
a1 String -> String -> a
`k` String
ns
That String
a2 ->
String
ms String -> String -> a
`k` String
a2
These String
a1 String
a2 ->
String
a1 String -> String -> a
`k` String
a2)
f String
m
f String
n
sep :: String
sep =
String -> String
chc (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shc Char
'|')
spacers :: String -> String -> String
spacers String
a1 String
a2 =
String
a1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a2
column4 :: [String]
column4 =
let hn' :: String
hn' =
String -> String
chn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shn Char
' ')
hm' :: String
hm' =
String -> String
chm (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shm Char
' ')
hs' :: String
hs' =
String -> String
chs (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shs Char
' ')
hr' :: String
hr' =
String -> String
chr (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shr Char
' ')
column12 :: [String]
column12 =
(String -> String -> String)
-> [String] -> [String] -> String -> String -> [String]
forall (f :: * -> *) a.
Semialign f =>
(String -> String -> a)
-> f String -> f String -> String -> String -> f a
alignWidth String -> String -> String
spacers (String -> String
chn (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
name'') (String -> String
chm (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
meaning'') String
hn' String
hm'
column3 :: [String]
column3 =
(String -> String -> String)
-> [String] -> [String] -> String -> String -> [String]
forall (f :: * -> *) a.
Semialign f =>
(String -> String -> a)
-> f String -> f String -> String -> String -> f a
alignWidth String -> String -> String
spacers [String]
column12 (String -> String
chs (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
source'') (String
hn' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hm') String
hs'
in (String -> String -> String)
-> [String] -> [String] -> String -> String -> [String]
forall (f :: * -> *) a.
Semialign f =>
(String -> String -> a)
-> f String -> f String -> String -> String -> f a
alignWidth String -> String -> String
spacers [String]
column3 (String -> String
chr (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
score'') (String
hn' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hs') String
hr'
String -> ConfigReader String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> String
newlines [String]
column4)
renderAcronyms ::
(Traversable t, HasAcronym a, HasShowScore a) =>
t a
-> ConfigReader String
renderAcronyms :: t a -> ConfigReader String
renderAcronyms t a
as =
t String -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (t String -> String)
-> ConfigReader (t String) -> ConfigReader String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> ConfigReader String) -> t a -> ConfigReader (t String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ConfigReader String
forall a.
(HasShowScore a, HasAcronym a) =>
a -> ConfigReader String
renderAcronym t a
as
renderHeaderAcronyms ::
(Traversable t, HasAcronym a, HasShowScore a) =>
t a
-> ConfigReader String
t a
as=
do String
h <- ConfigReader String
renderHeader
String
a <- t a -> ConfigReader String
forall (t :: * -> *) a.
(Traversable t, HasAcronym a, HasShowScore a) =>
t a -> ConfigReader String
renderAcronyms t a
as
String -> ConfigReader String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a)
spaceN ::
Int
-> String
-> String
spaceN :: Int -> String -> String
spaceN Int
n String
x =
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x
in Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n' Char
' '
escapeChars ::
String
-> String
escapeChars :: String -> String
escapeChars =
(String -> String) -> String -> String
forall a. Plated a => (a -> a) -> a -> a
transform
(\String
x -> case String
x of
Char
'&':Char
'l':Char
't':Char
';':String
r ->
Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r
Char
'&':Char
'g':Char
't':Char
';':String
r ->
Char
'>'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r
Char
'&':Char
'a':Char
'm':Char
'p':Char
';':String
r ->
Char
'&'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r
Char
'&':Char
'q':Char
'u':Char
'o':Char
't':Char
';':String
r ->
Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r
String
_ ->
String
x
)
splitEvery ::
Int
-> String
-> NonEmpty String
splitEvery :: Int -> String -> NonEmpty String
splitEvery Int
w String
x =
let (String
i, String
j) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
w String
x
k :: String -> NonEmpty String
k =
case String
j of
[] ->
String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Char
_:String
_ ->
(String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
<| Int -> String -> NonEmpty String
splitEvery Int
w String
j)
in String -> NonEmpty String
k String
i
newlines ::
[String]
-> String
newlines :: [String] -> String
newlines [String]
s =
[String]
s [String] -> (String -> String) -> String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\String
t -> String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")