{-|
Module      : Headroom.Types.Utils
Description : tilities related to data types
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Utilities related to data types.
-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Headroom.Types.Utils
  ( allValues
  , customOptions
  , dropFieldPrefix
  , readEnumCI
  , symbolCase
  )
where

import           Data.Aeson                     ( Options
                                                , defaultOptions
                                                , fieldLabelModifier
                                                )
import           RIO
import qualified RIO.Char                      as C
import qualified RIO.List                      as L
import           Text.Read                      ( ReadS )


-- | Returns all values of enum.
allValues :: (Bounded a, Enum a) => [a]
allValues :: [a]
allValues = [a
forall a. Bounded a => a
minBound ..]

-- | Custom /Aeson/ options.
customOptions :: Options
customOptions :: Options
customOptions =
  Options
defaultOptions { fieldLabelModifier :: String -> String
fieldLabelModifier = Char -> String -> String
symbolCase '-' (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
  (x :: Char
x : n :: Char
n : xs :: 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
  (x :: Char
x : n :: Char
n : xs :: 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
  (_ : xs :: String
xs)                   -> String -> String
dropFieldPrefix String
xs
  []                         -> []

-- | Parses enum value from its string representation.
readEnumCI :: (Bounded a, Enum a, Show a) => ReadS a
readEnumCI :: ReadS a
readEnumCI str :: String
str =
  let textRepr :: a -> String
textRepr = (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
C.toLower (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
      result :: Maybe a
result   = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\item :: a
item -> a -> String
textRepr a
item String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
C.toLower String
str) [a]
forall a. (Bounded a, Enum a) => [a]
allValues
  in  [(a, String)] -> (a -> [(a, String)]) -> Maybe a -> [(a, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\item :: a
item -> [(a
item, "")]) Maybe a
result

-- | 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 sym :: Char
sym = \case
  [] -> []
  (x :: Char
x : xs :: 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