module Database.Persist.Redis.Internal
    ( toKey
    , unKey
    , mkEntity
    , toKeyId
    , toKeyText
    , toInsertFields
    , toB
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Control.Monad.Fail (MonadFail)

import Database.Persist.EntityDef.Internal
import Database.Persist.Class
import Database.Persist.Types
import Database.Persist.Redis.Parser

toLabel :: FieldDef -> B.ByteString
toLabel :: FieldDef -> ByteString
toLabel = String -> ByteString
U.fromString (String -> ByteString)
-> (FieldDef -> String) -> FieldDef -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (FieldDef -> Text) -> FieldDef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB (FieldNameDB -> Text)
-> (FieldDef -> FieldNameDB) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB

toEntityString :: PersistEntity val => val -> Text
toEntityString :: forall val. PersistEntity val => val -> Text
toEntityString = EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text) -> (val -> EntityNameDB) -> val -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
entityDB (EntityDef -> EntityNameDB)
-> (val -> EntityDef) -> val -> EntityNameDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy val -> EntityDef
entityDef (Maybe val -> EntityDef) -> (val -> Maybe val) -> val -> EntityDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. val -> Maybe val
forall a. a -> Maybe a
Just

toEntityName :: EntityDef -> B.ByteString
toEntityName :: EntityDef -> ByteString
toEntityName = String -> ByteString
U.fromString (String -> ByteString)
-> (EntityDef -> String) -> EntityDef -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (EntityDef -> Text) -> EntityDef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text)
-> (EntityDef -> EntityNameDB) -> EntityDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
entityDB

mkEntity :: (MonadFail m, PersistEntity val) => Key val -> [(B.ByteString, B.ByteString)] -> m (Entity val)
mkEntity :: forall (m :: * -> *) val.
(MonadFail m, PersistEntity val) =>
Key val -> [(ByteString, ByteString)] -> m (Entity val)
mkEntity Key val
key [(ByteString, ByteString)]
fields = do
    let values :: [PersistValue]
values = [(ByteString, ByteString)] -> [PersistValue]
redisToPerisistValues [(ByteString, ByteString)]
fields
    let v :: Either Text val
v = [PersistValue] -> Either Text val
forall record.
PersistEntity record =>
[PersistValue] -> Either Text record
fromPersistValues [PersistValue]
values
    case Either Text val
v of
        Right val
body -> Entity val -> m (Entity val)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entity val -> m (Entity val)) -> Entity val -> m (Entity val)
forall a b. (a -> b) -> a -> b
$ Key val -> val -> Entity val
forall record. Key record -> record -> Entity record
Entity Key val
key val
body
        Left Text
a -> String -> m (Entity val)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
unpack Text
a)


zipAndConvert :: PersistField t => [FieldDef] -> [t] -> [(B.ByteString, B.ByteString)]
zipAndConvert :: forall t.
PersistField t =>
[FieldDef] -> [t] -> [(ByteString, ByteString)]
zipAndConvert [] [t]
_ = []
zipAndConvert [FieldDef]
_ [] = []
zipAndConvert (FieldDef
e:[FieldDef]
efields) (t
p:[t]
pfields) =
    let pv :: PersistValue
pv = t -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue t
p
    in
        if PersistValue
pv PersistValue -> PersistValue -> Bool
forall a. Eq a => a -> a -> Bool
== PersistValue
PersistNull then [FieldDef] -> [t] -> [(ByteString, ByteString)]
forall t.
PersistField t =>
[FieldDef] -> [t] -> [(ByteString, ByteString)]
zipAndConvert [FieldDef]
efields [t]
pfields
            else (FieldDef -> ByteString
toLabel FieldDef
e, PersistValue -> ByteString
toValue PersistValue
pv) (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [FieldDef] -> [t] -> [(ByteString, ByteString)]
forall t.
PersistField t =>
[FieldDef] -> [t] -> [(ByteString, ByteString)]
zipAndConvert [FieldDef]
efields [t]
pfields

-- | Create a list for create/update in Redis store
toInsertFields :: PersistEntity val => val -> [(B.ByteString, B.ByteString)]
toInsertFields :: forall val. PersistEntity val => val -> [(ByteString, ByteString)]
toInsertFields val
record = [FieldDef] -> [PersistValue] -> [(ByteString, ByteString)]
forall t.
PersistField t =>
[FieldDef] -> [t] -> [(ByteString, ByteString)]
zipAndConvert [FieldDef]
entity [PersistValue]
fields
    where
        entity :: [FieldDef]
entity = EntityDef -> [FieldDef]
entityFields (EntityDef -> [FieldDef]) -> EntityDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy val -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ val -> Maybe val
forall a. a -> Maybe a
Just val
record
        fields :: [PersistValue]
fields = val -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields val
record

underscoreBs :: B.ByteString
underscoreBs :: ByteString
underscoreBs = String -> ByteString
U.fromString String
"_"

-- | Make a key for given entity and id
toKeyText :: PersistEntity val => val -> Integer -> Text
toKeyText :: forall val. PersistEntity val => val -> Integer -> Text
toKeyText val
val Integer
k = val -> Text
forall val. PersistEntity val => val -> Text
toEntityString val
val Text -> Text -> Text
`T.append` String -> Text
T.pack String
"_" Text -> Text -> Text
`T.append` String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
k)

toB :: Text -> B.ByteString
toB :: Text -> ByteString
toB = String -> ByteString
U.fromString (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

-- | Create a string key for given entity
toObjectPrefix :: PersistEntity val => val -> B.ByteString
toObjectPrefix :: forall val. PersistEntity val => val -> ByteString
toObjectPrefix val
val = ByteString -> ByteString -> ByteString
B.append (EntityDef -> ByteString
toEntityName (EntityDef -> ByteString) -> EntityDef -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy val -> EntityDef
entityDef (Maybe val -> EntityDef) -> Maybe val -> EntityDef
forall a b. (a -> b) -> a -> b
$ val -> Maybe val
forall a. a -> Maybe a
Just val
val) ByteString
underscoreBs

idBs :: B.ByteString
idBs :: ByteString
idBs = String -> ByteString
U.fromString String
"id"

-- | Construct an id key, that is incremented for access
toKeyId :: PersistEntity val => val -> B.ByteString
toKeyId :: forall val. PersistEntity val => val -> ByteString
toKeyId val
val = ByteString -> ByteString -> ByteString
B.append (val -> ByteString
forall val. PersistEntity val => val -> ByteString
toObjectPrefix val
val) ByteString
idBs

unKey :: (PersistEntity val) => Key val -> B.ByteString
unKey :: forall val. PersistEntity val => Key val -> ByteString
unKey = PersistValue -> ByteString
toValue (PersistValue -> ByteString)
-> (Key val -> PersistValue) -> Key val -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> PersistValue
forall a. HasCallStack => [a] -> a
head ([PersistValue] -> PersistValue)
-> (Key val -> [PersistValue]) -> Key val -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key val -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues

toKey :: (Monad m, MonadFail m, PersistEntity val) => Text -> m (Key val)
toKey :: forall (m :: * -> *) val.
(Monad m, MonadFail m, PersistEntity val) =>
Text -> m (Key val)
toKey Text
x = case Either Text (Key val)
q of
        Right Key val
z -> Key val -> m (Key val)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Key val
z
        Left Text
a -> String -> m (Key val)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
unpack Text
a)
    where
        q :: Either Text (Key val)
q  = [PersistValue] -> Either Text (Key val)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [Text -> PersistValue
PersistText Text
x]