{-# 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 )
allValues :: (Bounded a, Enum a) => [a]
allValues :: [a]
allValues = [a
forall a. Bounded a => a
minBound ..]
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 }
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
[] -> []
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
symbolCase :: Char
-> String
-> String
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