Render.hs

{-# 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(Align(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
renderHeader =
  do  chc <- readHeadingSeparatorColours
      shc <- readSeparatorSpacing
      chn <- readHeadingNameColours
      shn <- readNameSpacing
      chm <- readHeadingMeaningColours
      shm <- readMeaningSpacing
      chs <- readHeadingSourceColours
      shs <- readSourceSpacing
      chr <- readHeadingScoreColours
      shr <- readScoreSpacing
      pure . intercalate (chc (replicate shc '|')) $
        [
          chn (spaceN shn nameHeader)
        , chm (spaceN shm meaningHeader)
        , chs (spaceN shs sourceHeader)
        , chr (spaceN shr scoreHeader)
        ]

renderAcronym ::
  (HasShowScore a, HasAcronym a) =>
  a
  -> ConfigReader String
renderAcronym a =
  let name' =
        escapeChars (a ^. name)
      meaning' =
        escapeChars (a ^. meaning)
      source' =
        escapeChars (a ^. source)
      score' =
        a ^. showScore
      spacesplit n x =
        toList $ spaceN n <$> splitEvery n x
  in  do  chc <- readAcronymSeparatorColours
          shc <- readSeparatorSpacing
          chn <- readAcronymNameColours
          shn <- readNameSpacing
          chm <- readAcronymMeaningColours
          shm <- readMeaningSpacing
          chs <- readAcronymSourceColours
          shs <- readSourceSpacing
          chr <- readAcronymScoreColours
          shr <- readScoreSpacing
          let name'' =
                spacesplit shn name'
              meaning'' =
                spacesplit shm meaning'
              source'' =
                spacesplit shs source'
              score'' =
                spacesplit shr score'
              alignWidth ::
                Align f =>
                (String -> String -> a)
                -> f String
                -> f String
                -> String
                -> String
                -> f a
              alignWidth k m n ms ns =
                alignWith
                  (\t -> case t of
                            This a1 ->
                              a1 `k` ns
                            That a2 ->
                              ms `k` a2
                            These a1 a2 ->
                              a1 `k` a2)
                  m
                  n
              spacers a1 a2 =
                a1 ++ chc (replicate shc '|') ++ a2
              column4 =
                let hn' =
                      chn (replicate shn ' ')
                    hm' =
                      chm (replicate shm ' ')
                    hs' =
                      chs (replicate shs ' ')
                    hr' =
                      chr (replicate shr ' ')
                    column12 =
                      alignWidth spacers (chn <$> name'') (chm <$> meaning'') hn' hm'
                    column3 =
                      alignWidth spacers column12 (chs <$> source'') (hn' ++ hm') hs'
                in  alignWidth spacers column3 (chr <$> score'') (hn' ++ hm' ++ hs') hr'
          pure (newlines column4)

renderAcronyms ::
  (Traversable t, HasAcronym a, HasShowScore a) =>
  t a
  -> ConfigReader String
renderAcronyms as =
  concat <$> traverse renderAcronym as

renderHeaderAcronyms ::
  (Traversable t, HasAcronym a, HasShowScore a) =>
  t a
  -> ConfigReader String
renderHeaderAcronyms as=
  do  h <- renderHeader
      a <- renderAcronyms as
      pure (h ++ "\n" ++ a)

spaceN ::
  Int
  -> String
  -> String
spaceN n x =
  let n' = n - length x
  in  take n x ++ replicate n' ' '

escapeChars ::
  String
  -> String
escapeChars =
  transform
    (\x ->  case x of
              '&':'l':'t':';':r ->
                '<':r
              '&':'g':'t':';':r ->
                '>':r
              '&':'a':'m':'p':';':r ->
                '&':r
              '&':'q':'u':'o':'t':';':r ->
                '"':r
              _ ->
                x
              )

splitEvery ::
  Int
  -> String
  -> NonEmpty String
splitEvery w x =
  let (i, j) = splitAt w x
      k =
        case j of
          [] ->
            pure
          _:_ ->
            (<| splitEvery w j)
  in  k i

newlines ::
  [String]
  -> String
newlines s =
  s >>= (\t -> t ++ "\n")