{-# LANGUAGE OverloadedStrings #-}

module Drasil.Data.Formats.CSV.Render
  ( -- ** Rendering
    CSVRenderOptions,
    DoubleQuotationPolicy (..),
    csvRenderOpts,
    renderCSV,
  )
where

import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T (any, replace, splitOn)
import Drasil.Data.Formats.CSV.Core (CSV, header, rows)
import Prettyprinter (Doc, Pretty (..), comma, dquotes, hardline, hcat, vcat)

-- | Options for rendering a 'CSV'.
newtype CSVRenderOptions = CSVRO DoubleQuotationPolicy

-- | Cell-wrapping policy: How often should cells be wrapped in double quotes?
data DoubleQuotationPolicy
  = -- | Only when necessary, i.e., a cell contains either double quotes, a comma,
    -- CR, LF, or CRLF.
    Minimal
  | -- | Everywhere.
    Everywhere

-- | Create 'CSVRenderOptions'.
csvRenderOpts :: DoubleQuotationPolicy -> CSVRenderOptions
csvRenderOpts :: DoubleQuotationPolicy -> CSVRenderOptions
csvRenderOpts = DoubleQuotationPolicy -> CSVRenderOptions
CSVRO

-- | Render a 'CSV' to a 'Doc' with the given options.
renderCSV :: CSVRenderOptions -> CSV -> Doc ann
renderCSV :: forall ann. CSVRenderOptions -> CSV -> Doc ann
renderCSV (CSVRO DoubleQuotationPolicy
dqp) CSV
csv = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ([Text] -> Doc ann) -> [[Text]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Doc ann
forall {ann}. [Text] -> Doc ann
renderRow [[Text]]
allRs
  where
    rs :: [[Text]]
rs = CSV -> [[Text]]
rows CSV
csv
    allRs :: [[Text]]
allRs = [[Text]] -> ([Text] -> [[Text]]) -> Maybe [Text] -> [[Text]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[Text]]
rs ([Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [[Text]]
rs) (Maybe [Text] -> [[Text]]) -> Maybe [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ CSV -> Maybe [Text]
header CSV
csv

    esc :: Text -> Doc ann
esc = DoubleQuotationPolicy -> Text -> Doc ann
forall ann. DoubleQuotationPolicy -> Text -> Doc ann
escapeCellPolicy DoubleQuotationPolicy
dqp
    renderRow :: [Text] -> Doc ann
renderRow = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ([Doc ann] -> Doc ann)
-> ([Text] -> [Doc ann]) -> [Text] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann])
-> ([Text] -> [Doc ann]) -> [Text] -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall {ann}. Text -> Doc ann
esc

-- | Internal: Escape a cell according to a 'DoubleQuotationPolicy'.
escapeCellPolicy :: DoubleQuotationPolicy -> Text -> Doc ann
escapeCellPolicy :: forall ann. DoubleQuotationPolicy -> Text -> Doc ann
escapeCellPolicy DoubleQuotationPolicy
Minimal Text
t
  | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsQuote Text
t = Text -> Doc ann
forall {ann}. Text -> Doc ann
quoteAndEscape Text
t
  | Bool
otherwise = Text -> Doc ann
forall {ann}. Text -> Doc ann
escapeHLs Text
t
escapeCellPolicy DoubleQuotationPolicy
Everywhere Text
t = Text -> Doc ann
forall {ann}. Text -> Doc ann
quoteAndEscape Text
t

-- | Internal: Check if a character appearing in a cell indicates that the cell
-- /must/ be quoted.
needsQuote :: Char -> Bool
needsQuote :: Char -> Bool
needsQuote Char
c = Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'"', Char
',', Char
'\n', Char
'\r']

-- | Internal: Replace all double-quotes with double-double-quotes in a cell and
-- wrap the whole cell in double-quotes.
quoteAndEscape :: Text -> Doc ann
quoteAndEscape :: forall {ann}. Text -> Doc ann
quoteAndEscape = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> (Text -> Doc ann) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ann
forall {ann}. Text -> Doc ann
escapeHLs (Text -> Doc ann) -> (Text -> Text) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\"\""

-- | Internal: `prettyprinter` needs us to manually deal with hard linebreaks.
escapeHLs :: Text -> Doc ann
escapeHLs :: forall {ann}. Text -> Doc ann
escapeHLs =
  [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat
    ([Doc ann] -> Doc ann) -> (Text -> [Doc ann]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
hardline
    ([Doc ann] -> [Doc ann])
-> (Text -> [Doc ann]) -> Text -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall {ann}. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
    ([Text] -> [Doc ann]) -> (Text -> [Text]) -> Text -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n"
    (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\r\n" Text
"\n"