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

module Data.BCP47.Persist () where

import Control.Monad ((<=<))
import Data.BCP47 (BCP47, fromText, toText)
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Database.Persist.Class (PersistField(..))
import Database.Persist.Sql (PersistFieldSql(..))

instance PersistField BCP47 where
  toPersistValue :: BCP47 -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (BCP47 -> Text) -> BCP47 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Text
toText
  fromPersistValue :: PersistValue -> Either Text BCP47
fromPersistValue = Text -> Either Text BCP47
fromText (Text -> Either Text BCP47)
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text BCP47
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistFieldSql BCP47 where
  -- sqlType for Text should be SqlString, but we don't hardcode in the
  -- unlikely case that changes
  sqlType :: Proxy BCP47 -> SqlType
sqlType Proxy BCP47
_ = Proxy Text -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
sqlType @Text Proxy Text
forall k (t :: k). Proxy t
Proxy