{-# LANGUAGE OverloadedStrings #-} module Database.Persist.Redis.Internal ( toInsertFields , toKey , toKeyId , toEntityName , deconvert ) where import Data.Data import Data.Text (Text, unpack) import Database.Persist.Types import Database.Persist.Class import Data.Aeson.Generic (encode) import qualified Data.ByteString as B import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString.UTF8 as U import qualified Database.Redis as R deconvert :: R.RedisCtx m f => f a -> a deconvert = undefined toLabel :: FieldDef a -> B.ByteString toLabel = U.fromString . unpack . unDBName . fieldDB toEntityName :: EntityDef a -> B.ByteString toEntityName = U.fromString . unpack . unDBName . entityDB moveToByteString :: Data a => Either Text a -> B.ByteString moveToByteString (Left a) = U.fromString $ unpack a moveToByteString (Right a) = toStrict $ encode a toValue :: PersistValue -> B.ByteString toValue (PersistText x) = U.fromString $ unpack x toValue (PersistByteString x) = x toValue (PersistInt64 x) = U.fromString $ show x toValue (PersistDouble x) = U.fromString $ show x toValue (PersistBool x) = U.fromString $ show x toValue (PersistDay x) = U.fromString $ show x toValue (PersistTimeOfDay x) = U.fromString $ show x toValue (PersistUTCTime x) = U.fromString $ show x toValue (PersistNull) = U.fromString "" toValue (PersistList x) = U.fromString $ show x toValue (PersistMap x) = U.fromString $ show x toValue (PersistObjectId _) = error "PersistObjectId is not supported." zipAndConvert :: PersistField t => [FieldDef a] -> [t] -> [(B.ByteString, B.ByteString)] zipAndConvert [] _ = [] zipAndConvert _ [] = [] zipAndConvert (e:efields) (p:pfields) = let pv = toPersistValue p in if pv == PersistNull then zipAndConvert efields pfields else (toLabel e, toValue pv) : zipAndConvert efields pfields -- | Create a list for create/update in Redis store toInsertFields :: PersistEntity val => val -> [(B.ByteString, B.ByteString)] toInsertFields record = zipAndConvert entity fields where entity = entityFields $ entityDef $ Just record fields = toPersistFields record underscoreBs :: B.ByteString underscoreBs = U.fromString "_" -- | Make a key for given entity and id toKey :: PersistEntity val => val -> Integer -> B.ByteString toKey val n = B.append (toObjectPrefix val) (U.fromString $ show n) -- | Create a string key for given entity toObjectPrefix :: PersistEntity val => val -> B.ByteString toObjectPrefix val = B.append (toEntityName $ entityDef $ Just val) underscoreBs idBs :: B.ByteString idBs = U.fromString "id" -- | Construct an id key, that is incremented for access toKeyId :: PersistEntity val => val -> B.ByteString toKeyId val = B.append (toObjectPrefix val) idBs