{-# 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 { forall tag a. 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 = forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> a -> RelationTuple
genericToTuple TupleableOptions
opts (forall tag a. Codec tag a -> a
unCodec Codec tag a
v)
where
opts :: TupleableOptions
opts = forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy tag) TupleableOptions
defaultTupleableOptions
fromTuple :: RelationTuple -> Either RelationalError (Codec tag a)
fromTuple RelationTuple
tup = forall tag a. a -> Codec tag a
Codec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> RelationTuple -> Either RelationalError a
genericFromTuple TupleableOptions
opts RelationTuple
tup
where
opts :: TupleableOptions
opts = forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy tag) TupleableOptions
defaultTupleableOptions
toAttributes :: Proxy (Codec tag a) -> Attributes
toAttributes Proxy (Codec tag a)
_ = forall a.
(Generic a, TupleableG (Rep a)) =>
TupleableOptions -> Proxy a -> Attributes
genericToAttributes TupleableOptions
opts (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
where
opts :: TupleableOptions
opts = forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (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 :: forall (proxy :: * -> *).
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 = forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) 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 :: forall (proxy :: * -> *). proxy (AddPrefix prefix) -> Text -> Text
modifyText proxy (AddPrefix prefix)
_ Text
oldText = Text
prefixText forall a. Semigroup a => a -> a -> a
<> Text
oldText
where
prefixText :: Text
prefixText = String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy prefix))
data DropPrefix (prefix :: Symbol)
instance KnownSymbol prefix => ModifyText (DropPrefix prefix) where
modifyText :: forall (proxy :: * -> *). proxy (DropPrefix prefix) -> Text -> Text
modifyText proxy (DropPrefix prefix)
_ Text
oldText = 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 (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy prefix))
data AddSuffix (suffix :: Symbol)
instance KnownSymbol suffix => ModifyText (AddSuffix suffix) where
modifyText :: forall (proxy :: * -> *). proxy (AddSuffix suffix) -> Text -> Text
modifyText proxy (AddSuffix suffix)
_ Text
oldText = Text
oldText forall a. Semigroup a => a -> a -> a
<> Text
suffixText
where
suffixText :: Text
suffixText = String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy suffix))
data DropSuffix (suffix :: Symbol)
instance KnownSymbol suffix => ModifyText (DropSuffix suffix) where
modifyText :: forall (proxy :: * -> *). proxy (DropSuffix suffix) -> Text -> Text
modifyText proxy (DropSuffix suffix)
_ Text
oldText = 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 (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy suffix))
data UpperCase
instance ModifyText UpperCase where
modifyText :: forall (proxy :: * -> *). proxy UpperCase -> Text -> Text
modifyText proxy UpperCase
_ = Text -> Text
T.toUpper
data LowerCase
instance ModifyText LowerCase where
modifyText :: forall (proxy :: * -> *). proxy LowerCase -> Text -> Text
modifyText proxy LowerCase
_ = Text -> Text
T.toLower
data TitleCase
instance ModifyText TitleCase where
modifyText :: forall (proxy :: * -> *). proxy TitleCase -> Text -> Text
modifyText proxy TitleCase
_ = Text -> Text
toTitle
data CamelCase
instance ModifyText CamelCase where
modifyText :: forall (proxy :: * -> *). proxy CamelCase -> Text -> Text
modifyText proxy CamelCase
_ = Text -> Text
toCamel
data PascalCase
instance ModifyText PascalCase where
modifyText :: forall (proxy :: * -> *). proxy PascalCase -> Text -> Text
modifyText proxy PascalCase
_ = Text -> Text
toPascal
data SnakeCase
instance ModifyText SnakeCase where
modifyText :: forall (proxy :: * -> *). proxy SnakeCase -> Text -> Text
modifyText proxy SnakeCase
_ = Text -> Text
toSnake
data SpinalCase
instance ModifyText SpinalCase where
modifyText :: forall (proxy :: * -> *). proxy SpinalCase -> Text -> Text
modifyText proxy SpinalCase
_ = Text -> Text
toSpinal
data TrainCase
instance ModifyText TrainCase where
modifyText :: forall (proxy :: * -> *). proxy TrainCase -> Text -> Text
modifyText proxy TrainCase
_ = Text -> Text
toTrain
type AsIs = ()
instance ModifyOptions () where
modifyOptions :: forall (proxy :: * -> *).
proxy () -> TupleableOptions -> TupleableOptions
modifyOptions proxy ()
_ = forall a. a -> a
id
instance ModifyText () where
modifyText :: forall (proxy :: * -> *). proxy () -> Text -> Text
modifyText proxy ()
_ = forall a. a -> a
id
data a <<< b
instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a <<< b) where
modifyOptions :: forall (proxy :: * -> *).
proxy (a <<< b) -> TupleableOptions -> TupleableOptions
modifyOptions proxy (a <<< b)
_ = forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
instance (ModifyText a, ModifyText b) => ModifyText (a <<< b) where
modifyText :: forall (proxy :: * -> *). proxy (a <<< b) -> Text -> Text
modifyText proxy (a <<< b)
_ = forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
data a >>> b
instance (ModifyOptions a, ModifyOptions b) => ModifyOptions (a >>> b) where
modifyOptions :: forall (proxy :: * -> *).
proxy (a >>> b) -> TupleableOptions -> TupleableOptions
modifyOptions proxy (a >>> b)
_ = forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (proxy :: * -> *).
ModifyOptions a =>
proxy a -> TupleableOptions -> TupleableOptions
modifyOptions (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
instance (ModifyText a, ModifyText b) => ModifyText (a >>> b) where
modifyText :: forall (proxy :: * -> *). proxy (a >>> b) -> Text -> Text
modifyText proxy (a >>> b)
_ = forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (forall {k} (t :: k). Proxy t
Proxy :: Proxy b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (proxy :: * -> *). ModifyText a => proxy a -> Text -> Text
modifyText (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)