{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Headroom.Serialization
Description : Various functions for data (de)serialization
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing support for data (de)serialization, mainly from/to /JSON/
and /YAML/.
-}

module Headroom.Serialization
  ( -- * JSON/YAML Serialization
    aesonOptions
  , dropFieldPrefix
  , symbolCase
    -- * Pretty Printing
  , prettyPrintYAML
  )
where

import           Data.Aeson                     ( Options
                                                , ToJSON(..)
                                                , defaultOptions
                                                , fieldLabelModifier
                                                )
import qualified Data.Yaml.Pretty              as YP
import           RIO
import qualified RIO.Char                      as C



-- | Custom /Aeson/ encoding options used for generic mapping between data
-- records and /JSON/ or /YAML/ values. Expects the fields in input to be
-- without the prefix and with words formated in /symbol case/
-- (example: record field @uUserName@, /JSON/ field @user-name@).
aesonOptions :: Options
aesonOptions :: Options
aesonOptions =
  Options
defaultOptions { fieldLabelModifier :: String -> String
fieldLabelModifier = Char -> String -> String
symbolCase Char
'-' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropFieldPrefix }


-- | Drops prefix from camel-case text.
--
-- >>> dropFieldPrefix "xxHelloWorld"
-- "helloWorld"
dropFieldPrefix :: String -> String
dropFieldPrefix :: String -> String
dropFieldPrefix = \case
  (Char
x : Char
n : String
xs) | Char -> Bool
C.isUpper Char
x Bool -> Bool -> Bool
&& Char -> Bool
C.isUpper Char
n -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
n Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
  (Char
x : Char
n : String
xs) | Char -> Bool
C.isUpper Char
x -> Char -> Char
C.toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
n Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
  (Char
_ : String
xs)                   -> String -> String
dropFieldPrefix String
xs
  []                         -> []


-- | Transforms camel-case text into text cased with given symbol.
--
-- >>> symbolCase '-' "fooBar"
-- "foo-bar"
symbolCase :: Char
           -- ^ word separator symbol
           -> String
           -- ^ input text
           -> String
           -- ^ processed text
symbolCase :: Char -> String -> String
symbolCase Char
sym = \case
  [] -> []
  (Char
x : String
xs) | Char -> Bool
C.isUpper Char
x -> Char
sym Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
C.toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> String -> String
symbolCase Char
sym String
xs
           | Bool
otherwise   -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> String -> String
symbolCase Char
sym String
xs


-- | Pretty prints given data as /YAML/.
prettyPrintYAML :: ToJSON a
                => a
                -- ^ data to pretty print
                -> Text
                -- ^ pretty printed /YAML/ output
prettyPrintYAML :: a -> Text
prettyPrintYAML = ByteString -> Text
decodeUtf8Lenient (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
YP.encodePretty Config
prettyConfig
  where prettyConfig :: Config
prettyConfig = (Text -> Text -> Ordering) -> Config -> Config
YP.setConfCompare Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Config
YP.defConfig