{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Auth.Simple.Instance.Persist.PasswordText where

import ClassyPrelude
import Database.Persist.Sql
import Yesod.Auth.Simple.Types

instance PersistFieldSql Password where
  sqlType :: Proxy Password -> SqlType
sqlType = SqlType -> Proxy Password -> SqlType
forall a b. a -> b -> a
const SqlType
SqlString

instance PersistField Password where
  toPersistValue :: Password -> PersistValue
toPersistValue (Password Text
e) = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue Text
e
  fromPersistValue :: PersistValue -> Either Text Password
fromPersistValue (PersistText Text
e) = Password -> Either Text Password
forall a b. b -> Either a b
Right (Password -> Either Text Password)
-> Password -> Either Text Password
forall a b. (a -> b) -> a -> b
$ Text -> Password
Password Text
e
  fromPersistValue PersistValue
e               = Text -> Either Text Password
forall a b. a -> Either a b
Left (Text -> Either Text Password) -> Text -> Either Text Password
forall a b. (a -> b) -> a -> b
$ [Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack [Char]
[Element Text]
"Not a PersistText: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PersistValue -> Text
forall a. Show a => a -> Text
tshow PersistValue
e