{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DefaultSignatures #-} module DomainDriven.Internal.HasFieldName where import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import Data.Set (Set) import Data.Text (Text) import qualified Data.Text as T import Data.Time import Data.Vector (Vector) import DomainDriven.Internal.Text import GHC.Generics import Prelude class HasFieldName t where fieldName :: Text default fieldName :: (Generic t, GHasFieldName (Rep t)) => Text fieldName = forall {k} (t :: k -> *) (x :: k). GHasFieldName t => t x -> Text gfieldName forall a b. (a -> b) -> a -> b $ forall a x. Generic a => a -> Rep a x from (forall a. HasCallStack => a undefined :: t) instance HasFieldName Int where fieldName :: Text fieldName = Text "int" instance HasFieldName Double where fieldName :: Text fieldName = Text "double" instance HasFieldName Text where fieldName :: Text fieldName = Text "text" instance HasFieldName Bool where fieldName :: Text fieldName = Text "bool" instance HasFieldName Day where fieldName :: Text fieldName = Text "day" instance HasFieldName UTCTime where fieldName :: Text fieldName = Text "utcTime" instance HasFieldName v => HasFieldName (M.Map k v) where fieldName :: Text fieldName = Text "mapOf" Text -> Text -> Text `camelAppendT` forall t. HasFieldName t => Text fieldName @v instance HasFieldName v => HasFieldName (HM.HashMap k v) where fieldName :: Text fieldName = Text "mapOf" Text -> Text -> Text `camelAppendT` forall t. HasFieldName t => Text fieldName @v instance HasFieldName v => HasFieldName (Set v) where fieldName :: Text fieldName = Text "setOf" Text -> Text -> Text `camelAppendT` forall t. HasFieldName t => Text fieldName @v instance {-# OVERLAPPABLE #-} HasFieldName v => HasFieldName [v] where fieldName :: Text fieldName = Text "listOf" Text -> Text -> Text `camelAppendT` forall t. HasFieldName t => Text fieldName @v instance {-# OVERLAPPING #-} HasFieldName String where fieldName :: Text fieldName = Text "string" instance HasFieldName v => HasFieldName (Vector v) where fieldName :: Text fieldName = Text "vectorOf" Text -> Text -> Text `camelAppendT` forall t. HasFieldName t => Text fieldName @v instance HasFieldName v => HasFieldName (Maybe v) where fieldName :: Text fieldName = forall t. HasFieldName t => Text fieldName @v class GHasFieldName t where gfieldName :: t x -> Text instance Datatype c => GHasFieldName (M1 i c f) where gfieldName :: forall (x :: k). M1 i c f x -> Text gfieldName = String -> Text T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String lowerFirst forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String datatypeName