{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Eventium.Store.Sql.Orphans
  (
  )
where

import qualified Data.ByteString as BS
import Data.Proxy
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.UUID
import Database.Persist
import Database.Persist.Sql
import Eventium.Store.Class
import Eventium.UUID

instance PersistField UUID where
  toPersistValue :: UUID -> PersistValue
toPersistValue = Text -> PersistValue
PersistText (Text -> PersistValue) -> (UUID -> Text) -> UUID -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
uuidToText
  fromPersistValue :: PersistValue -> Either Text UUID
fromPersistValue (PersistText Text
t) =
    case Text -> Maybe UUID
uuidFromText Text
t of
      Just UUID
x -> UUID -> Either Text UUID
forall a b. b -> Either a b
Right UUID
x
      Maybe UUID
Nothing -> Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Invalid UUID"
  fromPersistValue (PersistByteString ByteString
bs) =
    Either Text UUID
-> (UUID -> Either Text UUID) -> Maybe UUID -> Either Text UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Invalid UUID") UUID -> Either Text UUID
forall a b. b -> Either a b
Right (Text -> Maybe UUID
uuidFromText (ByteString -> Text
TE.decodeUtf8 ByteString
bs))
  fromPersistValue (PersistDbSpecific ByteString
bs) =
    Either Text UUID
-> (UUID -> Either Text UUID) -> Maybe UUID -> Either Text UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Invalid UUID") UUID -> Either Text UUID
forall a b. b -> Either a b
Right (Text -> Maybe UUID
uuidFromText (ByteString -> Text
TE.decodeUtf8 ByteString
bs))
  fromPersistValue (PersistLiteral_ LiteralType
_ ByteString
bs) =
    Either Text UUID
-> (UUID -> Either Text UUID) -> Maybe UUID -> Either Text UUID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Invalid UUID") UUID -> Either Text UUID
forall a b. b -> Either a b
Right (Text -> Maybe UUID
uuidFromText (ByteString -> Text
TE.decodeUtf8 ByteString
bs))
  fromPersistValue PersistValue
v = Text -> Either Text UUID
forall a b. a -> Either a b
Left (Text -> Either Text UUID) -> Text -> Either Text UUID
forall a b. (a -> b) -> a -> b
$ Text
"Expected UUID-compatible PersistValue, got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PersistValue -> String
forall a. Show a => a -> String
show PersistValue
v)

instance PersistFieldSql UUID where
  sqlType :: Proxy UUID -> SqlType
sqlType Proxy UUID
_ = Text -> SqlType
SqlOther Text
"uuid"

instance PersistField EventVersion where
  toPersistValue :: EventVersion -> PersistValue
toPersistValue = Int -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int -> PersistValue)
-> (EventVersion -> Int) -> EventVersion -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventVersion -> Int
unEventVersion
  fromPersistValue :: PersistValue -> Either Text EventVersion
fromPersistValue = (Int -> EventVersion)
-> Either Text Int -> Either Text EventVersion
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> EventVersion
EventVersion (Either Text Int -> Either Text EventVersion)
-> (PersistValue -> Either Text Int)
-> PersistValue
-> Either Text EventVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Int
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistFieldSql EventVersion where
  sqlType :: Proxy EventVersion -> SqlType
sqlType Proxy EventVersion
_ = Proxy Int -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Int
forall {k} (t :: k). Proxy t
Proxy :: Proxy Int)

instance PersistField SequenceNumber where
  toPersistValue :: SequenceNumber -> PersistValue
toPersistValue = Int -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Int -> PersistValue)
-> (SequenceNumber -> Int) -> SequenceNumber -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SequenceNumber -> Int
unSequenceNumber
  fromPersistValue :: PersistValue -> Either Text SequenceNumber
fromPersistValue = (Int -> SequenceNumber)
-> Either Text Int -> Either Text SequenceNumber
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SequenceNumber
SequenceNumber (Either Text Int -> Either Text SequenceNumber)
-> (PersistValue -> Either Text Int)
-> PersistValue
-> Either Text SequenceNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Int
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistFieldSql SequenceNumber where
  sqlType :: Proxy SequenceNumber -> SqlType
sqlType Proxy SequenceNumber
_ = Proxy Int -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType (Proxy Int
forall {k} (t :: k). Proxy t
Proxy :: Proxy Int)