{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module ProjectM36.Tupleable.Deriving
(
Codec(..)
, ModifyOptions(..)
, Field
, ModifyText(..)
, AddPrefix
, DropPrefix
, AddSuffix
, DropSuffix
, UpperCase
, LowerCase
, TitleCase
, CamelCase
, PascalCase
, SnakeCase
, SpinalCase
, TrainCase
, AsIs
, type (<<<)
, type (>>>)
, Generic
, module ProjectM36.Tupleable
) where
import Data.Maybe (fromMaybe)
import Data.Proxy
import qualified Data.Text as T
import Data.Text.Manipulate
import GHC.TypeLits
import GHC.Generics (Generic, Rep)
import ProjectM36.Tupleable
newtype Codec tag a = Codec { Codec tag a -> a
unCodec :: a }
instance (ModifyOptions tag, Generic a, TupleableG (Rep a)) => Tupleable (Codec tag a) where
toTuple :: Codec tag a -> RelationTuple
toTuple Codec tag a
v = TupleableOptions -> a -> RelationTuple
forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> a -> RelationTuple
genericToTuple TupleableOptions
opts (Codec tag a -> a
forall tag a. Codec tag a -> a
unCodec Codec tag a
v)
where
opts :: TupleableOptions
opts = Proxy tag -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag) TupleableOptions
defaultTupleableOptions
fromTuple :: RelationTuple -> Either RelationalError (Codec tag a)
fromTuple RelationTuple
tup = a -> Codec tag a
forall tag a. a -> Codec tag a
Codec (a -> Codec tag a)
-> Either RelationalError a -> Either RelationalError (Codec tag a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TupleableOptions -> RelationTuple -> Either RelationalError a
forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> RelationTuple -> Either RelationalError a
genericFromTuple TupleableOptions
opts RelationTuple
tup
where
opts :: TupleableOptions
opts = Proxy tag -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag) TupleableOptions
defaultTupleableOptions
toAttributes :: Proxy (Codec tag a) -> Attributes
toAttributes Proxy (Codec tag a)
_ = TupleableOptions -> Proxy a -> Attributes
forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> Proxy a -> Attributes
genericToAttributes TupleableOptions
opts (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
where
opts :: TupleableOptions
opts = Proxy tag -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy tag
forall k (t :: k). Proxy t
Proxy :: Proxy tag) TupleableOptions
defaultTupleableOptions
class ModifyOptions a where
modifyOptions :: proxy a -> TupleableOptions -> TupleableOptions
data Field a
instance ModifyText a => ModifyOptions (Field a) where
modifyOptions :: proxy (Field a) -> TupleableOptions -> TupleableOptions
modifyOptions proxy (Field a)
_ TupleableOptions
opts = TupleableOptions
opts { fieldModifier :: Text -> Text
fieldModifier = Text -> Text
newFieldModifier }
where
newFieldModifier :: Text -> Text
newFieldModifier = Proxy a -> Text -> Text
forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TupleableOptions -> Text -> Text
fieldModifier TupleableOptions
opts
class ModifyText a where
modifyText :: proxy a -> T.Text -> T.Text
data AddPrefix (prefix :: Symbol)
instance KnownSymbol prefix => ModifyText (AddPrefix prefix) where
modifyText :: proxy (AddPrefix prefix) -> Text -> Text
modifyText proxy (AddPrefix prefix)
_ Text
oldText = Text
prefixText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oldText
where
prefixText :: Text
prefixText = String -> Text
T.pack (Proxy prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy prefix
forall k (t :: k). Proxy t
Proxy :: Proxy prefix))
data DropPrefix (prefix :: Symbol)
instance KnownSymbol prefix => ModifyText (DropPrefix prefix) where
modifyText :: proxy (DropPrefix prefix) -> Text -> Text
modifyText proxy (DropPrefix prefix)
_ Text
oldText = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
oldText (Text -> Text -> Maybe Text
T.stripPrefix Text
prefixText Text
oldText)
where
prefixText :: Text
prefixText = String -> Text
T.pack (Proxy prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy prefix
forall k (t :: k). Proxy t
Proxy :: Proxy prefix))
data AddSuffix (suffix :: Symbol)
instance KnownSymbol suffix => ModifyText (AddSuffix suffix) where
modifyText :: proxy (AddSuffix suffix) -> Text -> Text
modifyText proxy (AddSuffix suffix)
_ Text
oldText = Text
oldText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffixText
where
suffixText :: Text
suffixText = String -> Text
T.pack (Proxy suffix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy suffix
forall k (t :: k). Proxy t
Proxy :: Proxy suffix))
data DropSuffix (suffix :: Symbol)
instance KnownSymbol suffix => ModifyText (DropSuffix suffix) where
modifyText :: proxy (DropSuffix suffix) -> Text -> Text
modifyText proxy (DropSuffix suffix)
_ Text
oldText = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
oldText (Text -> Text -> Maybe Text
T.stripSuffix Text
suffixText Text
oldText)
where
suffixText :: Text
suffixText = String -> Text
T.pack (Proxy suffix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy suffix
forall k (t :: k). Proxy t
Proxy :: Proxy suffix))
data UpperCase
instance ModifyText UpperCase where
modifyText :: proxy UpperCase -> Text -> Text
modifyText proxy UpperCase
_ = Text -> Text
T.toUpper
data LowerCase
instance ModifyText LowerCase where
modifyText :: proxy LowerCase -> Text -> Text
modifyText proxy LowerCase
_ = Text -> Text
T.toLower
data TitleCase
instance ModifyText TitleCase where
modifyText :: proxy TitleCase -> Text -> Text
modifyText proxy TitleCase
_ = Text -> Text
toTitle
data CamelCase
instance ModifyText CamelCase where
modifyText :: proxy CamelCase -> Text -> Text
modifyText proxy CamelCase
_ = Text -> Text
toCamel
data PascalCase
instance ModifyText PascalCase where
modifyText :: proxy PascalCase -> Text -> Text
modifyText proxy PascalCase
_ = Text -> Text
toPascal
data SnakeCase
instance ModifyText SnakeCase where
modifyText :: proxy SnakeCase -> Text -> Text
modifyText proxy SnakeCase
_ = Text -> Text
toSnake
data SpinalCase
instance ModifyText SpinalCase where
modifyText :: proxy SpinalCase -> Text -> Text
modifyText proxy SpinalCase
_ = Text -> Text
toSpinal
data TrainCase
instance ModifyText TrainCase where
modifyText :: proxy TrainCase -> Text -> Text
modifyText proxy TrainCase
_ = Text -> Text
toTrain
type AsIs = ()
instance ModifyOptions () where
modifyOptions :: proxy () -> TupleableOptions -> TupleableOptions
modifyOptions proxy ()
_ = TupleableOptions -> TupleableOptions
forall a. a -> a
id
instance ModifyText () where
modifyText :: proxy () -> Text -> Text
modifyText proxy ()
_ = Text -> Text
forall a. a -> a
id
data a <<< b
instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a <<< b) where
modifyOptions :: proxy (a <<< b) -> TupleableOptions -> TupleableOptions
modifyOptions proxy (a <<< b)
_ = Proxy a -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (TupleableOptions -> TupleableOptions)
-> (TupleableOptions -> TupleableOptions)
-> TupleableOptions
-> TupleableOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy b -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
instance (ModifyText a, ModifyText b) => ModifyText (a <<< b) where
modifyText :: proxy (a <<< b) -> Text -> Text
modifyText proxy (a <<< b)
_ = Proxy a -> Text -> Text
forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy b -> Text -> Text
forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
data a >>> b
instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a >>> b) where
modifyOptions :: proxy (a >>> b) -> TupleableOptions -> TupleableOptions
modifyOptions proxy (a >>> b)
_ = Proxy b -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) (TupleableOptions -> TupleableOptions)
-> (TupleableOptions -> TupleableOptions)
-> TupleableOptions
-> TupleableOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TupleableOptions -> TupleableOptions
forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
instance (ModifyText a, ModifyText b) => ModifyText (a >>> b) where
modifyText :: proxy (a >>> b) -> Text -> Text
modifyText proxy (a >>> b)
_ = Proxy b -> Text -> Text
forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Text -> Text
forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)