{-# LANGUAGE
    DeriveGeneric
  , OverloadedStrings
  , ScopedTypeVariables
  , TypeFamilies
  , CPP
  #-}
#if MIN_VERSION_base(4,9,0)
{-# LANGUAGE DataKinds #-}
#endif
-- | Helper functions that can be reused by libraries interoperating with generic-aeson.
module Generics.Generic.Aeson.Util
  ( formatLabel
  , multipleConstructors
  , conNameT
  , selNameT
  , module Generics.Generic.IsEnum
  , Settings (..)
  , defaultSettings
  ) where

import Control.Monad ((<=<))
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics
import qualified Data.Text as T

import Generics.Generic.IsEnum

#if MIN_VERSION_base(4,15,0)
import Data.Kind (Type)
#else
type Type = (*)
#endif

#if MIN_VERSION_base(4,9,0)
conNameT :: forall (t :: Type -> Meta -> (Type -> Type) -> Type -> Type) i c (f :: Type -> Type) p. Constructor c => Settings -> t i c f p -> Text
#else
conNameT :: forall c (t :: Type -> (Type -> Type) -> Type -> Type) (f :: Type -> Type) a. Constructor c => Settings -> t c f a -> Text
#endif
conNameT :: Settings -> t i c f p -> Text
conNameT Settings
set t i c f p
x = Settings -> Text -> Text
formatLabel Settings
set (Text -> Text) -> (t i c f p -> Text) -> t i c f p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (t i c f p -> String) -> t i c f p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t i c f p -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (t i c f p -> Text) -> t i c f p -> Text
forall a b. (a -> b) -> a -> b
$ t i c f p
x

#if MIN_VERSION_base(4,9,0)
selNameT :: forall (t :: Type -> Meta -> (Type -> Type) -> Type -> Type) i s (f :: Type -> Type) p. Selector s => Settings -> t i s f p -> Maybe Text
#else
selNameT :: forall s (t :: Type -> (Type -> Type) -> Type -> Type) (f :: Type -> Type) a. Selector s => Settings -> t s f a -> Maybe Text
#endif
selNameT :: Settings -> t i s f p -> Maybe Text
selNameT Settings
set t i s f p
x = case Settings -> Text -> Text
formatLabel Settings
set (Text -> Text) -> (t i s f p -> Text) -> t i s f p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (t i s f p -> String) -> t i s f p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t i s f p -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (t i s f p -> Text) -> t i s f p -> Text
forall a b. (a -> b) -> a -> b
$ t i s f p
x of
  Text
"" -> Maybe Text
forall a. Maybe a
Nothing
  Text
n  -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n

-- | Lowercases the first letter and strips leading and trailing underscores.
formatLabel :: Settings -> Text -> Text
formatLabel :: Settings -> Text -> Text
formatLabel Settings
set
  = Text -> Text
firstLetterToLower
  (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripLeadingAndTrailingUnderscore
  (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Text -> Text
stripPref Settings
set

stripPref :: Settings -> Text -> Text
stripPref :: Settings -> Text -> Text
stripPref Settings
set Text
s = ((Text -> Text)
-> (String -> Text -> Text) -> Maybe String -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (\String
p Text
t -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text
disallowEmpty (Text -> Maybe Text) -> (Text -> Maybe Text) -> Text -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Text -> Maybe Text
T.stripPrefix (String -> Text
T.pack String
p)) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t) (Maybe String -> Text -> Text)
-> (Settings -> Maybe String) -> Settings -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> Maybe String
stripPrefix) Settings
set Text
s
  where
    disallowEmpty :: Text -> Maybe Text
disallowEmpty Text
x
      | Text -> Bool
T.null  Text
x = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
      | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x

stripLeadingAndTrailingUnderscore :: Text -> Text
stripLeadingAndTrailingUnderscore :: Text -> Text
stripLeadingAndTrailingUnderscore = Text -> Text
stripLeadingUnderscore
                                  (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripTrailingUnderscore

stripLeadingUnderscore :: Text -> Text
stripLeadingUnderscore :: Text -> Text
stripLeadingUnderscore Text
x = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
x Text -> Text
stripLeadingUnderscore (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"_" Text
x

stripTrailingUnderscore :: Text -> Text
stripTrailingUnderscore :: Text -> Text
stripTrailingUnderscore Text
x = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
x (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
"_" Text
x

firstLetterToLower :: Text -> Text
firstLetterToLower :: Text -> Text
firstLetterToLower Text
tx =
  case Text -> Maybe (Char, Text)
T.uncons Text
tx of
    Maybe (Char, Text)
Nothing -> Text
""
    Just (Char
c, Text
t) -> Char -> Text -> Text
T.cons (Char -> Char
toLower Char
c) Text
t

multipleConstructors :: [a] -> Bool
multipleConstructors :: [a] -> Bool
multipleConstructors = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- Use String over Text so OverloadedStrings isn't necessary
data Settings = Settings { Settings -> Maybe String
stripPrefix :: Maybe String }
  deriving Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = Settings :: Maybe String -> Settings
Settings { stripPrefix :: Maybe String
stripPrefix = Maybe String
forall a. Maybe a
Nothing }