{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}

{-|
Module      : Headroom.Configuration.Enrich
Description : Simple enrichment of YAML configuration stubs
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains mini-DSL for enrichment of generated /YAML/ configurations,
i.e. replacing default values with real ones, etc. This is intentionally done
without the "Data.Yaml" and parsing, because that way all comments inside YAML
file would be lost.
-}

module Headroom.Configuration.Enrich
  ( -- * Data Types
    Enrich(..)
  , ValueType(..)
    -- * Field Generators
  , withArray
  , withText
    -- * Field Manipulation
  , replaceEmptyValue
  )
where

import           Data.Aeson                          ( ToJSON(..) )
import           Headroom.Serialization              ( prettyPrintYAML )
import           RIO
import qualified RIO.Map                            as M
import qualified RIO.Text                           as T
import qualified RIO.Text.Partial                   as TP


---------------------------------  DATA TYPES  ---------------------------------

-- | Simple wrapper representing single step of enrichment.
newtype Enrich = Enrich
  { Enrich -> Text -> Text
enrich :: Text -> Text
  -- ^ takes input text and does enrichment
  }


instance Semigroup Enrich where
  Enrich Text -> Text
fnA <> :: Enrich -> Enrich -> Enrich
<> Enrich Text -> Text
fnB = (Text -> Text) -> Enrich
Enrich ((Text -> Text) -> Enrich) -> (Text -> Text) -> Enrich
forall a b. (a -> b) -> a -> b
$ Text -> Text
fnA (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fnB


instance Monoid Enrich where
  mempty :: Enrich
mempty = (Text -> Text) -> Enrich
Enrich Text -> Text
forall a. a -> a
id


-- | Represents type of the field value.
data ValueType
  = Array
  -- ^ type of /YAML/ array
  | String
  -- ^ type of /YAML/ string
  deriving (ValueType -> ValueType -> Bool
(ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool) -> Eq ValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueType -> ValueType -> Bool
$c/= :: ValueType -> ValueType -> Bool
== :: ValueType -> ValueType -> Bool
$c== :: ValueType -> ValueType -> Bool
Eq, Int -> ValueType -> ShowS
[ValueType] -> ShowS
ValueType -> String
(Int -> ValueType -> ShowS)
-> (ValueType -> String)
-> ([ValueType] -> ShowS)
-> Show ValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueType] -> ShowS
$cshowList :: [ValueType] -> ShowS
show :: ValueType -> String
$cshow :: ValueType -> String
showsPrec :: Int -> ValueType -> ShowS
$cshowsPrec :: Int -> ValueType -> ShowS
Show)


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Generates /YAML/ array field from given list and field name.
withArray :: ToJSON a
          => [a]
          -- ^ input list used as value
          -> Text
          -- ^ field name
          -> (ValueType, Text)
          -- ^ generated fields as @(valueType, generatedField)@
withArray :: [a] -> Text -> (ValueType, Text)
withArray [a]
list Text
field = (ValueType
Array, Text -> [a] -> Text
forall a. ToJSON a => Text -> a -> Text
asYAML Text
field [a]
list)


-- | Generates /YAML/ string from given text value and field name.
withText :: Text
         -- ^ input text value
         -> Text
         -- ^ field name
         -> (ValueType, Text)
         -- ^ generated fields as @(valueType, generatedField)@
withText :: Text -> Text -> (ValueType, Text)
withText Text
text Text
field = (ValueType
String, Text -> Text -> Text
forall a. ToJSON a => Text -> a -> Text
asYAML Text
field Text
text)


-- | Replaces empty value of given field with actual generated value.
replaceEmptyValue :: Text
                  -- ^ field name
                  -> (Text -> (ValueType, Text))
                  -- ^ field value generator function
                  -> Enrich
                  -- ^ resulting enrichment step
replaceEmptyValue :: Text -> (Text -> (ValueType, Text)) -> Enrich
replaceEmptyValue Text
field Text -> (ValueType, Text)
replaceFn = (Text -> Text) -> Enrich
Enrich ((Text -> Text) -> Enrich) -> (Text -> Text) -> Enrich
forall a b. (a -> b) -> a -> b
$ \Text
doc -> do
  Text -> Text -> Text -> Text
TP.replace Text
old Text
new Text
doc
 where
  (ValueType
tpe, Text
new) = Text -> (ValueType, Text)
replaceFn Text
field
  old :: Text
old        = Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ValueType -> Text
emptyValue ValueType
tpe


------------------------------  PRIVATE FUNCTIONS  -----------------------------

asYAML :: ToJSON a => Text -> a -> Text
asYAML :: Text -> a -> Text
asYAML Text
field a
value = Text -> Text
T.stripEnd (Text -> Text) -> (Map Text a -> Text) -> Map Text a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text a -> Text
forall a. ToJSON a => a -> Text
prettyPrintYAML (Map Text a -> Text) -> Map Text a -> Text
forall a b. (a -> b) -> a -> b
$ [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
field, a
value)]


emptyValue :: ValueType -> Text
emptyValue :: ValueType -> Text
emptyValue ValueType
Array  = Text
"[]"
emptyValue ValueType
String = Text
"\"\""