{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards, DataKinds, TypeOperators, UndecidableInstances, GeneralizedNewtypeDeriving #-}
module Database.Persist.Class.PersistField
    ( PersistField (..)
    , getPersistMap
    , OverflowNatural(..)
    ) where

import Control.Arrow (second)
import Control.Monad ((<=<))
import Control.Applicative ((<|>))
import qualified Data.Aeson as A
import Data.ByteString.Char8 (ByteString, unpack, readInt)
import qualified Data.ByteString.Lazy as L
import Data.Fixed
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.IntMap as IM
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Read (double)
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TERR
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Text.Blaze.Html
import Text.Blaze.Html.Renderer.Text (renderHtml)
import GHC.TypeLits
import Data.Ratio (numerator, denominator)

import Database.Persist.Types.Base

import Data.Time (Day(..), TimeOfDay, UTCTime,
    parseTimeM)
import Data.Time (defaultTimeLocale)

#ifdef HIGH_PRECISION_DATE
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
#endif


-- | This class teaches Persistent how to take a custom type and marshal it to and from a 'PersistValue', allowing it to be stored in a database.
--
-- ==== __Examples__
--
-- ===== Simple Newtype
--
-- You can use @newtype@ to add more type safety/readability to a basis type like 'ByteString'. In these cases, just derive 'PersistField' and @PersistFieldSql@:
--
-- @
-- {-\# LANGUAGE GeneralizedNewtypeDeriving #-}
--
-- newtype HashedPassword = HashedPassword 'ByteString'
--   deriving (Eq, Show, 'PersistField', PersistFieldSql)
-- @
--
-- ===== Smart Constructor Newtype
--
-- In this example, we create a 'PersistField' instance for a newtype following the "Smart Constructor" pattern.
--
-- @
-- {-\# LANGUAGE GeneralizedNewtypeDeriving #-}
-- import qualified "Data.Text" as T
-- import qualified "Data.Char" as C
--
-- -- | An American Social Security Number
-- newtype SSN = SSN 'Text'
--  deriving (Eq, Show, PersistFieldSql)
--
-- mkSSN :: 'Text' -> 'Either' 'Text' SSN
-- mkSSN t = if (T.length t == 9) && (T.all C.isDigit t)
--  then 'Right' $ SSN t
--  else 'Left' $ "Invalid SSN: " <> t
--
-- instance 'PersistField' SSN where
--   'toPersistValue' (SSN t) = 'PersistText' t
--   'fromPersistValue' ('PersistText' t) = mkSSN t
--   -- Handle cases where the database does not give us PersistText
--   'fromPersistValue' x = 'Left' $ "File.hs: When trying to deserialize an SSN: expected PersistText, received: " <> T.pack (show x)
-- @
--
-- Tips:
--
-- * This file contain dozens of 'PersistField' instances you can look at for examples.
-- * Typically custom 'PersistField' instances will only accept a single 'PersistValue' constructor in 'fromPersistValue'.
-- * Internal 'PersistField' instances accept a wide variety of 'PersistValue's to accomodate e.g. storing booleans as integers, booleans or strings.
-- * If you're making a custom instance and using a SQL database, you'll also need @PersistFieldSql@ to specify the type of the database column.
class PersistField a where
    toPersistValue :: a -> PersistValue
    fromPersistValue :: PersistValue -> Either T.Text a

#ifndef NO_OVERLAP
instance {-# OVERLAPPING #-} PersistField [Char] where
    toPersistValue :: [Char] -> PersistValue
toPersistValue = Text -> PersistValue
PersistText (Text -> PersistValue)
-> ([Char] -> Text) -> [Char] -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    fromPersistValue :: PersistValue -> Either Text [Char]
fromPersistValue (PersistText Text
s) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s
    fromPersistValue (PersistByteString ByteString
bs) =
        [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TERR.lenientDecode ByteString
bs
    fromPersistValue (PersistInt64 Int64
i) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Int64 -> [Char]
forall a. Show a => a -> [Char]
Prelude.show Int64
i
    fromPersistValue (PersistDouble Double
d) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
Prelude.show Double
d
    fromPersistValue (PersistRational Rational
r) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Rational -> [Char]
forall a. Show a => a -> [Char]
Prelude.show Rational
r
    fromPersistValue (PersistDay Day
d) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Day -> [Char]
forall a. Show a => a -> [Char]
Prelude.show Day
d
    fromPersistValue (PersistTimeOfDay TimeOfDay
d) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> [Char]
forall a. Show a => a -> [Char]
Prelude.show TimeOfDay
d
    fromPersistValue (PersistUTCTime UTCTime
d) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ UTCTime -> [Char]
forall a. Show a => a -> [Char]
Prelude.show UTCTime
d
    fromPersistValue PersistValue
PersistNull = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Unexpected null"
    fromPersistValue (PersistBool Bool
b) = [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right ([Char] -> Either Text [Char]) -> [Char] -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Bool -> [Char]
forall a. Show a => a -> [Char]
Prelude.show Bool
b
    fromPersistValue (PersistList [PersistValue]
_) = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Cannot convert PersistList to String"
    fromPersistValue (PersistMap [(Text, PersistValue)]
_) = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Cannot convert PersistMap to String"
    fromPersistValue (PersistLiteral_ LiteralType
_ ByteString
_) = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Cannot convert PersistLiteral_ to String"
    fromPersistValue (PersistArray [PersistValue]
_) = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Cannot convert PersistArray to String"
    fromPersistValue (PersistObjectId ByteString
_) = Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"Cannot convert PersistObjectId to String"
#endif

instance PersistField ByteString where
    toPersistValue :: ByteString -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistByteString
    fromPersistValue :: PersistValue -> Either Text ByteString
fromPersistValue (PersistByteString ByteString
bs) = ByteString -> Either Text ByteString
forall a b. b -> Either a b
Right ByteString
bs
    fromPersistValue PersistValue
x = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Either Text Text -> Either Text ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
x

instance PersistField T.Text where
    toPersistValue :: Text -> PersistValue
toPersistValue = Text -> PersistValue
PersistText
    fromPersistValue :: PersistValue -> Either Text Text
fromPersistValue = PersistValue -> Either Text Text
fromPersistValueText

instance PersistField TL.Text where
    toPersistValue :: Text -> PersistValue
toPersistValue = Text -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (Text -> PersistValue) -> (Text -> Text) -> Text -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
    fromPersistValue :: PersistValue -> Either Text Text
fromPersistValue = (Text -> Text) -> Either Text Text -> Either Text Text
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
TL.fromStrict (Either Text Text -> Either Text Text)
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistField Html where
    toPersistValue :: Html -> PersistValue
toPersistValue = Text -> PersistValue
PersistText (Text -> PersistValue) -> (Html -> Text) -> Html -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
renderHtml
    fromPersistValue :: PersistValue -> Either Text Html
fromPersistValue = (Text -> Html) -> Either Text Text -> Either Text Html
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToMarkup :: T.Text -> Html) (Either Text Text -> Either Text Html)
-> (PersistValue -> Either Text Text)
-> PersistValue
-> Either Text Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text Text
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistField Int where
    toPersistValue :: Int -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> (Int -> Int64) -> Int -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Int
fromPersistValue = Text -> Text -> PersistValue -> Either Text Int
forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
"Int" Text
"integer"

instance PersistField Int8 where
    toPersistValue :: Int8 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> (Int8 -> Int64) -> Int8 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Int8
fromPersistValue = Text -> Text -> PersistValue -> Either Text Int8
forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
"Int8" Text
"integer"

instance PersistField Int16 where
    toPersistValue :: Int16 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Int16 -> Int64) -> Int16 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Int16
fromPersistValue = Text -> Text -> PersistValue -> Either Text Int16
forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
"Int16" Text
"integer"

instance PersistField Int32 where
    toPersistValue :: Int32 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Int32 -> Int64) -> Int32 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Int32
fromPersistValue = Text -> Text -> PersistValue -> Either Text Int32
forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
"Int32" Text
"integer"

instance PersistField Int64 where
    toPersistValue :: Int64 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64
    fromPersistValue :: PersistValue -> Either Text Int64
fromPersistValue = Text -> Text -> PersistValue -> Either Text Int64
forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
"Int64" Text
"integer"

fromPersistValueIntegral :: Integral a => Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral :: forall a.
Integral a =>
Text -> Text -> PersistValue -> Either Text a
fromPersistValueIntegral Text
haskellType Text
sqlType PersistValue
pv = case PersistValue
pv of
    PersistInt64 Int64
i ->
        a -> Either Text a
forall a b. b -> Either a b
Right (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
    PersistDouble Double
i ->
        a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> a -> Either Text a
forall a b. (a -> b) -> a -> b
$ Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
i -- oracle
    PersistRational Rational
i ->
        case Rational -> Integer
forall a. Ratio a -> a
denominator Rational
i of
            Integer
1 ->
                a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> a -> Either Text a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
i
            Integer
_denom ->
                Either Text a
boom
    PersistByteString ByteString
bs ->
        case ByteString -> Maybe (Int, ByteString)
readInt ByteString
bs of  -- oracle
           Just (Int
i,ByteString
"") ->
               a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> a -> Either Text a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
           Just (Int
i,ByteString
extra) ->
               Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> Int -> ByteString -> Text
forall result.
Show result =>
Text -> ByteString -> result -> ByteString -> Text
extraInputError Text
haskellType ByteString
bs Int
i ByteString
extra
           Maybe (Int, ByteString)
Nothing ->
               Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> Text
intParseError Text
haskellType ByteString
bs
    PersistValue
_ ->
        Either Text a
boom
  where
    boom :: Either Text a
boom =
        Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
haskellType Text
sqlType PersistValue
pv

extraInputError :: (Show result)
                => Text -- ^ Haskell type
                -> ByteString -- ^ Original bytestring
                -> result -- ^ Integer result
                -> ByteString -- ^  Extra bytestring
                -> Text -- ^ Error message
extraInputError :: forall result.
Show result =>
Text -> ByteString -> result -> ByteString -> Text
extraInputError Text
haskellType ByteString
original result
result ByteString
extra = [Text] -> Text
T.concat
    [ Text
"Parsed "
    , ByteString -> Text
TE.decodeUtf8 ByteString
original
    , Text
" into Haskell type `"
    , Text
haskellType
    , Text
"` with value"
    , [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ result -> [Char]
forall a. Show a => a -> [Char]
show result
result
    , Text
"but had extra input: "
    , ByteString -> Text
TE.decodeUtf8 ByteString
extra
    ]

intParseError :: Text -- ^ Haskell type
              -> ByteString -- ^ Original bytestring
              -> Text -- ^ Error message
intParseError :: Text -> ByteString -> Text
intParseError Text
haskellType ByteString
original = [Text] -> Text
T.concat
    [ Text
"Failed to parse Haskell type `"
    , Text
haskellType
    , Text
" from "
    , ByteString -> Text
TE.decodeUtf8 ByteString
original
    ]

instance PersistField Data.Word.Word where
    toPersistValue :: Word -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> (Word -> Int64) -> Word -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Word
fromPersistValue (PersistInt64 Int64
i) = Word -> Either Text Word
forall a b. b -> Either a b
Right (Word -> Either Text Word) -> Word -> Either Text Word
forall a b. (a -> b) -> a -> b
$ Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Word
forall a b. a -> Either a b
Left (Text -> Either Text Word) -> Text -> Either Text Word
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Word" Text
"integer" PersistValue
x

instance PersistField Word8 where
    toPersistValue :: Word8 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Word8 -> Int64) -> Word8 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Word8
fromPersistValue (PersistInt64 Int64
i) = Word8 -> Either Text Word8
forall a b. b -> Either a b
Right (Word8 -> Either Text Word8) -> Word8 -> Either Text Word8
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Word8
forall a b. a -> Either a b
Left (Text -> Either Text Word8) -> Text -> Either Text Word8
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Word8" Text
"integer" PersistValue
x

instance PersistField Word16 where
    toPersistValue :: Word16 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Word16 -> Int64) -> Word16 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Word16
fromPersistValue (PersistInt64 Int64
i) = Word16 -> Either Text Word16
forall a b. b -> Either a b
Right (Word16 -> Either Text Word16) -> Word16 -> Either Text Word16
forall a b. (a -> b) -> a -> b
$ Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Word16
forall a b. a -> Either a b
Left (Text -> Either Text Word16) -> Text -> Either Text Word16
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Word16" Text
"integer" PersistValue
x

instance PersistField Word32 where
    toPersistValue :: Word32 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Word32 -> Int64) -> Word32 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Word32
fromPersistValue (PersistInt64 Int64
i) = Word32 -> Either Text Word32
forall a b. b -> Either a b
Right (Word32 -> Either Text Word32) -> Word32 -> Either Text Word32
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Word32
forall a b. a -> Either a b
Left (Text -> Either Text Word32) -> Text -> Either Text Word32
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Word32" Text
"integer" PersistValue
x

instance PersistField Word64 where
    toPersistValue :: Word64 -> PersistValue
toPersistValue = Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> (Word64 -> Int64) -> Word64 -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPersistValue :: PersistValue -> Either Text Word64
fromPersistValue (PersistInt64 Int64
i) = Word64 -> Either Text Word64
forall a b. b -> Either a b
Right (Word64 -> Either Text Word64) -> Word64 -> Either Text Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Word64
forall a b. a -> Either a b
Left (Text -> Either Text Word64) -> Text -> Either Text Word64
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Word64" Text
"integer" PersistValue
x

instance PersistField Double where
    toPersistValue :: Double -> PersistValue
toPersistValue = Double -> PersistValue
PersistDouble
    fromPersistValue :: PersistValue -> Either Text Double
fromPersistValue (PersistDouble Double
d) = Double -> Either Text Double
forall a b. b -> Either a b
Right Double
d
    fromPersistValue (PersistRational Rational
r) = Double -> Either Text Double
forall a b. b -> Either a b
Right (Double -> Either Text Double) -> Double -> Either Text Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r
    fromPersistValue (PersistInt64 Int64
i) = Double -> Either Text Double
forall a b. b -> Either a b
Right (Double -> Either Text Double) -> Double -> Either Text Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text Double
forall a b. a -> Either a b
Left (Text -> Either Text Double) -> Text -> Either Text Double
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Double" Text
"double, rational, or integer" PersistValue
x

instance (HasResolution a) => PersistField (Fixed a) where
    toPersistValue :: Fixed a -> PersistValue
toPersistValue = Rational -> PersistValue
PersistRational (Rational -> PersistValue)
-> (Fixed a -> Rational) -> Fixed a -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Rational
forall a. Real a => a -> Rational
toRational
    fromPersistValue :: PersistValue -> Either Text (Fixed a)
fromPersistValue (PersistRational Rational
r) = Fixed a -> Either Text (Fixed a)
forall a b. b -> Either a b
Right (Fixed a -> Either Text (Fixed a))
-> Fixed a -> Either Text (Fixed a)
forall a b. (a -> b) -> a -> b
$ Rational -> Fixed a
forall a. Fractional a => Rational -> a
fromRational Rational
r
    fromPersistValue (PersistText Text
t) = case ReadS (Fixed a)
forall a. Read a => ReadS a
reads ReadS (Fixed a) -> ReadS (Fixed a)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of --  NOTE: Sqlite can store rationals just as string
      [(Fixed a
a, [Char]
"")] -> Fixed a -> Either Text (Fixed a)
forall a b. b -> Either a b
Right Fixed a
a
      [(Fixed a, [Char])]
_ -> Text -> Either Text (Fixed a)
forall a b. a -> Either a b
Left (Text -> Either Text (Fixed a)) -> Text -> Either Text (Fixed a)
forall a b. (a -> b) -> a -> b
$ Text
"Can not read " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as Fixed"
    fromPersistValue (PersistDouble Double
d) = Fixed a -> Either Text (Fixed a)
forall a b. b -> Either a b
Right (Fixed a -> Either Text (Fixed a))
-> Fixed a -> Either Text (Fixed a)
forall a b. (a -> b) -> a -> b
$ Double -> Fixed a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
    fromPersistValue (PersistInt64 Int64
i) = Fixed a -> Either Text (Fixed a)
forall a b. b -> Either a b
Right (Fixed a -> Either Text (Fixed a))
-> Fixed a -> Either Text (Fixed a)
forall a b. (a -> b) -> a -> b
$ Int64 -> Fixed a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue PersistValue
x = Text -> Either Text (Fixed a)
forall a b. a -> Either a b
Left (Text -> Either Text (Fixed a)) -> Text -> Either Text (Fixed a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Fixed" Text
"rational, string, double, or integer" PersistValue
x

instance PersistField Rational where
    toPersistValue :: Rational -> PersistValue
toPersistValue = Rational -> PersistValue
PersistRational
    fromPersistValue :: PersistValue -> Either Text Rational
fromPersistValue (PersistRational Rational
r) = Rational -> Either Text Rational
forall a b. b -> Either a b
Right Rational
r
    fromPersistValue (PersistDouble Double
d) = Rational -> Either Text Rational
forall a b. b -> Either a b
Right (Rational -> Either Text Rational)
-> Rational -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d
    fromPersistValue (PersistText Text
t) = case ReadS Pico
forall a. Read a => ReadS a
reads ReadS Pico -> ReadS Pico
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of --  NOTE: Sqlite can store rationals just as string
      [(Pico
a, [Char]
"")] -> Rational -> Either Text Rational
forall a b. b -> Either a b
Right (Rational -> Either Text Rational)
-> Rational -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Pico -> Rational
forall a. Real a => a -> Rational
toRational (Pico
a :: Pico)
      [(Pico, [Char])]
_ -> Text -> Either Text Rational
forall a b. a -> Either a b
Left (Text -> Either Text Rational) -> Text -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Text
"Can not read " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as Rational (Pico in fact)"
    fromPersistValue (PersistInt64 Int64
i) = Rational -> Either Text Rational
forall a b. b -> Either a b
Right (Rational -> Either Text Rational)
-> Rational -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    fromPersistValue (PersistByteString ByteString
bs) = case Reader Double
double Reader Double -> Reader Double
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'0' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TERR.lenientDecode ByteString
bs of
                                                Right (Double
ret,Text
"") -> Rational -> Either Text Rational
forall a b. b -> Either a b
Right (Rational -> Either Text Rational)
-> Rational -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ret
                                                Right (Double
a,Text
b) -> Text -> Either Text Rational
forall a b. a -> Either a b
Left (Text -> Either Text Rational) -> Text -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Text
"Invalid bytestring[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]: expected a double but returned " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ((Double, Text) -> [Char]
forall a. Show a => a -> [Char]
show (Double
a,Text
b))
                                                Left [Char]
xs -> Text -> Either Text Rational
forall a b. a -> Either a b
Left (Text -> Either Text Rational) -> Text -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Text
"Invalid bytestring[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]: expected a double but returned " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
xs)
    fromPersistValue PersistValue
x = Text -> Either Text Rational
forall a b. a -> Either a b
Left (Text -> Either Text Rational) -> Text -> Either Text Rational
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Rational" Text
"rational, double, string, integer, or bytestring" PersistValue
x

instance PersistField Bool where
    toPersistValue :: Bool -> PersistValue
toPersistValue = Bool -> PersistValue
PersistBool
    fromPersistValue :: PersistValue -> Either Text Bool
fromPersistValue (PersistBool Bool
b) = Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
b
    fromPersistValue (PersistInt64 Int64
i) = Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Bool -> Either Text Bool) -> Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0
    fromPersistValue (PersistByteString ByteString
i) = case ByteString -> Maybe (Int, ByteString)
readInt ByteString
i of
                                               Just (Int
0,ByteString
"") -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
False
                                               Just (Int
1,ByteString
"") -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True
                                               Maybe (Int, ByteString)
xs -> Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to parse Haskell type `Bool` from PersistByteString. Original value:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Parsed by `readInt` as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Maybe (Int, ByteString) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (Int, ByteString)
xs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Expected '1'."
    fromPersistValue PersistValue
x = Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Bool" Text
"boolean, integer, or bytestring of '1' or '0'" PersistValue
x

instance PersistField Day where
    toPersistValue :: Day -> PersistValue
toPersistValue = Day -> PersistValue
PersistDay
    fromPersistValue :: PersistValue -> Either Text Day
fromPersistValue (PersistDay Day
d) = Day -> Either Text Day
forall a b. b -> Either a b
Right Day
d
    fromPersistValue (PersistInt64 Int64
i) = Day -> Either Text Day
forall a b. b -> Either a b
Right (Day -> Either Text Day) -> Day -> Either Text Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day
ModifiedJulianDay (Integer -> Day) -> Integer -> Day
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
i
    fromPersistValue x :: PersistValue
x@(PersistText Text
t) =
        case ReadS Day
forall a. Read a => ReadS a
reads ReadS Day -> ReadS Day
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
            (Day
d, [Char]
_):[(Day, [Char])]
_ -> Day -> Either Text Day
forall a b. b -> Either a b
Right Day
d
            [(Day, [Char])]
_ -> Text -> Either Text Day
forall a b. a -> Either a b
Left (Text -> Either Text Day) -> Text -> Either Text Day
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"Day" PersistValue
x
    fromPersistValue x :: PersistValue
x@(PersistByteString ByteString
s) =
        case ReadS Day
forall a. Read a => ReadS a
reads ReadS Day -> ReadS Day
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpack ByteString
s of
            (Day
d, [Char]
_):[(Day, [Char])]
_ -> Day -> Either Text Day
forall a b. b -> Either a b
Right Day
d
            [(Day, [Char])]
_ -> Text -> Either Text Day
forall a b. a -> Either a b
Left (Text -> Either Text Day) -> Text -> Either Text Day
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"Day" PersistValue
x
    fromPersistValue PersistValue
x = Text -> Either Text Day
forall a b. a -> Either a b
Left (Text -> Either Text Day) -> Text -> Either Text Day
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Day" Text
"day, integer, string or bytestring" PersistValue
x

instance PersistField TimeOfDay where
    toPersistValue :: TimeOfDay -> PersistValue
toPersistValue = TimeOfDay -> PersistValue
PersistTimeOfDay
    fromPersistValue :: PersistValue -> Either Text TimeOfDay
fromPersistValue (PersistTimeOfDay TimeOfDay
d) = TimeOfDay -> Either Text TimeOfDay
forall a b. b -> Either a b
Right TimeOfDay
d
    fromPersistValue x :: PersistValue
x@(PersistText Text
t) =
        case ReadS TimeOfDay
forall a. Read a => ReadS a
reads ReadS TimeOfDay -> ReadS TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t of
            (TimeOfDay
d, [Char]
_):[(TimeOfDay, [Char])]
_ -> TimeOfDay -> Either Text TimeOfDay
forall a b. b -> Either a b
Right TimeOfDay
d
            [(TimeOfDay, [Char])]
_ -> Text -> Either Text TimeOfDay
forall a b. a -> Either a b
Left (Text -> Either Text TimeOfDay) -> Text -> Either Text TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"TimeOfDay" PersistValue
x
    fromPersistValue x :: PersistValue
x@(PersistByteString ByteString
s) =
        case ReadS TimeOfDay
forall a. Read a => ReadS a
reads ReadS TimeOfDay -> ReadS TimeOfDay
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpack ByteString
s of
            (TimeOfDay
d, [Char]
_):[(TimeOfDay, [Char])]
_ -> TimeOfDay -> Either Text TimeOfDay
forall a b. b -> Either a b
Right TimeOfDay
d
            [(TimeOfDay, [Char])]
_ -> Text -> Either Text TimeOfDay
forall a b. a -> Either a b
Left (Text -> Either Text TimeOfDay) -> Text -> Either Text TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"TimeOfDay" PersistValue
x
    fromPersistValue PersistValue
x = Text -> Either Text TimeOfDay
forall a b. a -> Either a b
Left (Text -> Either Text TimeOfDay) -> Text -> Either Text TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"TimeOfDay" Text
"time, string, or bytestring" PersistValue
x

instance PersistField UTCTime where
    toPersistValue :: UTCTime -> PersistValue
toPersistValue = UTCTime -> PersistValue
PersistUTCTime
    fromPersistValue :: PersistValue -> Either Text UTCTime
fromPersistValue (PersistUTCTime UTCTime
d) = UTCTime -> Either Text UTCTime
forall a b. b -> Either a b
Right UTCTime
d
#ifdef HIGH_PRECISION_DATE
    fromPersistValue (PersistInt64 i)   = Right $ posixSecondsToUTCTime $ (/ (1000 * 1000 * 1000)) $ fromIntegral $ i
#endif
    fromPersistValue x :: PersistValue
x@(PersistText Text
t)  =
        let s :: [Char]
s = Text -> [Char]
T.unpack Text
t
        in
          case [(UTCTime, [Char])] -> Maybe (NonEmpty (UTCTime, [Char]))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty (ReadS UTCTime
forall a. Read a => ReadS a
reads [Char]
s) of
            Maybe (NonEmpty (UTCTime, [Char]))
Nothing ->
                case [Char] -> Maybe UTCTime
parse8601 [Char]
s Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Maybe UTCTime
parsePretty [Char]
s of
                    Maybe UTCTime
Nothing -> Text -> Either Text UTCTime
forall a b. a -> Either a b
Left (Text -> Either Text UTCTime) -> Text -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"UTCTime" PersistValue
x
                    Just UTCTime
x' -> UTCTime -> Either Text UTCTime
forall a b. b -> Either a b
Right UTCTime
x'
            Just NonEmpty (UTCTime, [Char])
matches ->
                -- The 'Read UTCTime' instance in newer versions of 'time' is
                -- more flexible when parsing UTCTime strings and will return
                -- UTCTimes with different microsecond parsings. The last result
                -- here contains the parsed UTCTime with as much microsecond
                -- precision parsed as posssible.
                UTCTime -> Either Text UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either Text UTCTime) -> UTCTime -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ (UTCTime, [Char]) -> UTCTime
forall a b. (a, b) -> a
fst ((UTCTime, [Char]) -> UTCTime) -> (UTCTime, [Char]) -> UTCTime
forall a b. (a -> b) -> a -> b
$ NonEmpty (UTCTime, [Char]) -> (UTCTime, [Char])
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (UTCTime, [Char])
matches
      where
#if MIN_VERSION_time(1,5,0)
        parseTime' :: [Char] -> [Char] -> Maybe UTCTime
parseTime' = Bool -> TimeLocale -> [Char] -> [Char] -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
#else
        parseTime' = parseTime defaultTimeLocale
#endif
        parse8601 :: [Char] -> Maybe UTCTime
parse8601 = [Char] -> [Char] -> Maybe UTCTime
parseTime' [Char]
"%FT%T%Q"
        parsePretty :: [Char] -> Maybe UTCTime
parsePretty = [Char] -> [Char] -> Maybe UTCTime
parseTime' [Char]
"%F %T%Q"
    fromPersistValue x :: PersistValue
x@(PersistByteString ByteString
s) =
        case ReadS UTCTime
forall a. Read a => ReadS a
reads ReadS UTCTime -> ReadS UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
unpack ByteString
s of
            (UTCTime
d, [Char]
_):[(UTCTime, [Char])]
_ -> UTCTime -> Either Text UTCTime
forall a b. b -> Either a b
Right UTCTime
d
            [(UTCTime, [Char])]
_ -> Text -> Either Text UTCTime
forall a b. a -> Either a b
Left (Text -> Either Text UTCTime) -> Text -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue -> Text
forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
"UTCTime" PersistValue
x

    fromPersistValue PersistValue
x = Text -> Either Text UTCTime
forall a b. a -> Either a b
Left (Text -> Either Text UTCTime) -> Text -> Either Text UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"UTCTime" Text
"time, integer, string, or bytestring" PersistValue
x

-- | Prior to @persistent-2.11.0@, we provided an instance of
-- 'PersistField' for the 'Natural' type. This was in error, because
-- 'Natural' represents an infinite value, and databases don't have
-- reasonable types for this.
--
-- The instance for 'Natural' used the 'Int64' underlying type, which will
-- cause underflow and overflow errors. This type has the exact same code
-- in the instances, and will work seamlessly.
--
-- A more appropriate type for this is the 'Word' series of types from
-- "Data.Word". These have a bounded size, are guaranteed to be
-- non-negative, and are quite efficient for the database to store.
--
-- @since 2.11.0
newtype OverflowNatural = OverflowNatural { OverflowNatural -> Natural
unOverflowNatural :: Natural }
    deriving (OverflowNatural -> OverflowNatural -> Bool
(OverflowNatural -> OverflowNatural -> Bool)
-> (OverflowNatural -> OverflowNatural -> Bool)
-> Eq OverflowNatural
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverflowNatural -> OverflowNatural -> Bool
== :: OverflowNatural -> OverflowNatural -> Bool
$c/= :: OverflowNatural -> OverflowNatural -> Bool
/= :: OverflowNatural -> OverflowNatural -> Bool
Eq, Int -> OverflowNatural -> [Char] -> [Char]
[OverflowNatural] -> [Char] -> [Char]
OverflowNatural -> [Char]
(Int -> OverflowNatural -> [Char] -> [Char])
-> (OverflowNatural -> [Char])
-> ([OverflowNatural] -> [Char] -> [Char])
-> Show OverflowNatural
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> OverflowNatural -> [Char] -> [Char]
showsPrec :: Int -> OverflowNatural -> [Char] -> [Char]
$cshow :: OverflowNatural -> [Char]
show :: OverflowNatural -> [Char]
$cshowList :: [OverflowNatural] -> [Char] -> [Char]
showList :: [OverflowNatural] -> [Char] -> [Char]
Show, Eq OverflowNatural
Eq OverflowNatural =>
(OverflowNatural -> OverflowNatural -> Ordering)
-> (OverflowNatural -> OverflowNatural -> Bool)
-> (OverflowNatural -> OverflowNatural -> Bool)
-> (OverflowNatural -> OverflowNatural -> Bool)
-> (OverflowNatural -> OverflowNatural -> Bool)
-> (OverflowNatural -> OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural -> OverflowNatural)
-> Ord OverflowNatural
OverflowNatural -> OverflowNatural -> Bool
OverflowNatural -> OverflowNatural -> Ordering
OverflowNatural -> OverflowNatural -> OverflowNatural
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OverflowNatural -> OverflowNatural -> Ordering
compare :: OverflowNatural -> OverflowNatural -> Ordering
$c< :: OverflowNatural -> OverflowNatural -> Bool
< :: OverflowNatural -> OverflowNatural -> Bool
$c<= :: OverflowNatural -> OverflowNatural -> Bool
<= :: OverflowNatural -> OverflowNatural -> Bool
$c> :: OverflowNatural -> OverflowNatural -> Bool
> :: OverflowNatural -> OverflowNatural -> Bool
$c>= :: OverflowNatural -> OverflowNatural -> Bool
>= :: OverflowNatural -> OverflowNatural -> Bool
$cmax :: OverflowNatural -> OverflowNatural -> OverflowNatural
max :: OverflowNatural -> OverflowNatural -> OverflowNatural
$cmin :: OverflowNatural -> OverflowNatural -> OverflowNatural
min :: OverflowNatural -> OverflowNatural -> OverflowNatural
Ord, Integer -> OverflowNatural
OverflowNatural -> OverflowNatural
OverflowNatural -> OverflowNatural -> OverflowNatural
(OverflowNatural -> OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural)
-> (OverflowNatural -> OverflowNatural)
-> (Integer -> OverflowNatural)
-> Num OverflowNatural
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: OverflowNatural -> OverflowNatural -> OverflowNatural
+ :: OverflowNatural -> OverflowNatural -> OverflowNatural
$c- :: OverflowNatural -> OverflowNatural -> OverflowNatural
- :: OverflowNatural -> OverflowNatural -> OverflowNatural
$c* :: OverflowNatural -> OverflowNatural -> OverflowNatural
* :: OverflowNatural -> OverflowNatural -> OverflowNatural
$cnegate :: OverflowNatural -> OverflowNatural
negate :: OverflowNatural -> OverflowNatural
$cabs :: OverflowNatural -> OverflowNatural
abs :: OverflowNatural -> OverflowNatural
$csignum :: OverflowNatural -> OverflowNatural
signum :: OverflowNatural -> OverflowNatural
$cfromInteger :: Integer -> OverflowNatural
fromInteger :: Integer -> OverflowNatural
Num)

instance
  TypeError
    ( 'Text "The instance of PersistField for the Natural type was removed."
    ':$$: 'Text "Please see the documentation for OverflowNatural if you want to "
    ':$$: 'Text "continue using the old behavior or want to see documentation on "
    ':$$: 'Text "why the instance was removed."
    ':$$: 'Text ""
    ':$$: 'Text "This error instance will be removed in a future release."
    )
  =>
    PersistField Natural
  where
    toPersistValue :: Natural -> PersistValue
toPersistValue = Natural -> PersistValue
forall a. HasCallStack => a
undefined
    fromPersistValue :: PersistValue -> Either Text Natural
fromPersistValue = PersistValue -> Either Text Natural
forall a. HasCallStack => a
undefined

instance PersistField OverflowNatural where
  toPersistValue :: OverflowNatural -> PersistValue
toPersistValue = (Int64 -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue :: Int64 -> PersistValue) (Int64 -> PersistValue)
-> (OverflowNatural -> Int64) -> OverflowNatural -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int64)
-> (OverflowNatural -> Natural) -> OverflowNatural -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverflowNatural -> Natural
unOverflowNatural
  fromPersistValue :: PersistValue -> Either Text OverflowNatural
fromPersistValue PersistValue
x = case (PersistValue -> Either Text Int64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
x :: Either Text Int64) of
    Left Text
err -> Text -> Either Text OverflowNatural
forall a b. a -> Either a b
Left (Text -> Either Text OverflowNatural)
-> Text -> Either Text OverflowNatural
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"Int64" Text
"OverflowNatural" Text
err
    Right Int64
int -> OverflowNatural -> Either Text OverflowNatural
forall a b. b -> Either a b
Right (OverflowNatural -> Either Text OverflowNatural)
-> OverflowNatural -> Either Text OverflowNatural
forall a b. (a -> b) -> a -> b
$ Natural -> OverflowNatural
OverflowNatural (Natural -> OverflowNatural) -> Natural -> OverflowNatural
forall a b. (a -> b) -> a -> b
$ Int64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
int -- TODO use bimap?

instance PersistField a => PersistField (Maybe a) where
    toPersistValue :: Maybe a -> PersistValue
toPersistValue Maybe a
Nothing = PersistValue
PersistNull
    toPersistValue (Just a
a) = a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue a
a
    fromPersistValue :: PersistValue -> Either Text (Maybe a)
fromPersistValue PersistValue
PersistNull = Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    fromPersistValue PersistValue
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either Text a -> Either Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
x

instance {-# OVERLAPPABLE #-} PersistField a => PersistField [a] where
    toPersistValue :: [a] -> PersistValue
toPersistValue = [PersistValue] -> PersistValue
PersistList ([PersistValue] -> PersistValue)
-> ([a] -> [PersistValue]) -> [a] -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> PersistValue) -> [a] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue
    fromPersistValue :: PersistValue -> Either Text [a]
fromPersistValue (PersistList [PersistValue]
l) = [PersistValue] -> Either Text [a]
forall a. PersistField a => [PersistValue] -> Either Text [a]
fromPersistList [PersistValue]
l
    fromPersistValue (PersistText Text
t) = PersistValue -> Either Text [a]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t)
    fromPersistValue (PersistByteString ByteString
bs)
        | Just [PersistValue]
values <- ByteString -> Maybe [PersistValue]
forall a. FromJSON a => ByteString -> Maybe a
A.decode' ([ByteString] -> ByteString
L.fromChunks [ByteString
bs]) = [PersistValue] -> Either Text [a]
forall a. PersistField a => [PersistValue] -> Either Text [a]
fromPersistList [PersistValue]
values
    -- avoid the need for a migration to fill in empty lists.
    -- also useful when Persistent is not the only one filling in the data
    fromPersistValue (PersistValue
PersistNull) = [a] -> Either Text [a]
forall a b. b -> Either a b
Right []
    fromPersistValue PersistValue
x = Text -> Either Text [a]
forall a b. a -> Either a b
Left (Text -> Either Text [a]) -> Text -> Either Text [a]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"List" Text
"list, string, bytestring or null" PersistValue
x

instance PersistField a => PersistField (V.Vector a) where
  toPersistValue :: Vector a -> PersistValue
toPersistValue = [a] -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([a] -> PersistValue)
-> (Vector a -> [a]) -> Vector a -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList
  fromPersistValue :: PersistValue -> Either Text (Vector a)
fromPersistValue = (Text -> Either Text (Vector a))
-> ([a] -> Either Text (Vector a))
-> Either Text [a]
-> Either Text (Vector a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Text
e -> Text -> Either Text (Vector a)
forall a b. a -> Either a b
Left (Text
"Failed to parse Haskell type `Vector`: " Text -> Text -> Text
`T.append` Text
e))
                            (Vector a -> Either Text (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either Text (Vector a))
-> ([a] -> Vector a) -> [a] -> Either Text (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList) (Either Text [a] -> Either Text (Vector a))
-> (PersistValue -> Either Text [a])
-> PersistValue
-> Either Text (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text [a]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance (Ord a, PersistField a) => PersistField (S.Set a) where
    toPersistValue :: Set a -> PersistValue
toPersistValue = [PersistValue] -> PersistValue
PersistList ([PersistValue] -> PersistValue)
-> (Set a -> [PersistValue]) -> Set a -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> PersistValue) -> [a] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([a] -> [PersistValue])
-> (Set a -> [a]) -> Set a -> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList
    fromPersistValue :: PersistValue -> Either Text (Set a)
fromPersistValue (PersistList [PersistValue]
list) =
      [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Either Text [a] -> Either Text (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text [a]
forall a. PersistField a => [PersistValue] -> Either Text [a]
fromPersistList [PersistValue]
list
    fromPersistValue (PersistText Text
t) = PersistValue -> Either Text (Set a)
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue (ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t)
    fromPersistValue (PersistByteString ByteString
bs)
        | Just [PersistValue]
values <- ByteString -> Maybe [PersistValue]
forall a. FromJSON a => ByteString -> Maybe a
A.decode' ([ByteString] -> ByteString
L.fromChunks [ByteString
bs]) =
            [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Either Text [a] -> Either Text (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text [a]
forall a. PersistField a => [PersistValue] -> Either Text [a]
fromPersistList [PersistValue]
values
    fromPersistValue PersistValue
PersistNull = Set a -> Either Text (Set a)
forall a b. b -> Either a b
Right Set a
forall a. Set a
S.empty
    fromPersistValue PersistValue
x = Text -> Either Text (Set a)
forall a b. a -> Either a b
Left (Text -> Either Text (Set a)) -> Text -> Either Text (Set a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Set" Text
"list, string, bytestring or null" PersistValue
x

instance (PersistField a, PersistField b) => PersistField (a,b) where
    toPersistValue :: (a, b) -> PersistValue
toPersistValue (a
x,b
y) = [PersistValue] -> PersistValue
PersistList [a -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue a
x, b -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue b
y]
    fromPersistValue :: PersistValue -> Either Text (a, b)
fromPersistValue PersistValue
v =
        case PersistValue -> Either Text [PersistValue]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
v of
            Right [PersistValue
x,PersistValue
y]  -> (,) (a -> b -> (a, b)) -> Either Text a -> Either Text (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
x Either Text (b -> (a, b)) -> Either Text b -> Either Text (a, b)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PersistValue -> Either Text b
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
y
            Left Text
e       -> Text -> Either Text (a, b)
forall a b. a -> Either a b
Left Text
e
            Either Text [PersistValue]
_            -> Text -> Either Text (a, b)
forall a b. a -> Either a b
Left (Text -> Either Text (a, b)) -> Text -> Either Text (a, b)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 2 item PersistList, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PersistValue -> [Char]
forall a. Show a => a -> [Char]
show PersistValue
v

instance PersistField v => PersistField (IM.IntMap v) where
    toPersistValue :: IntMap v -> PersistValue
toPersistValue = [(Int, v)] -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue ([(Int, v)] -> PersistValue)
-> (IntMap v -> [(Int, v)]) -> IntMap v -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IM.toList
    fromPersistValue :: PersistValue -> Either Text (IntMap v)
fromPersistValue = ([(Int, v)] -> IntMap v)
-> Either Text [(Int, v)] -> Either Text (IntMap v)
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, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IM.fromList (Either Text [(Int, v)] -> Either Text (IntMap v))
-> (PersistValue -> Either Text [(Int, v)])
-> PersistValue
-> Either Text (IntMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistValue -> Either Text [(Int, v)]
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

instance PersistField v => PersistField (M.Map T.Text v) where
    toPersistValue :: Map Text v -> PersistValue
toPersistValue = [(Text, PersistValue)] -> PersistValue
PersistMap ([(Text, PersistValue)] -> PersistValue)
-> (Map Text v -> [(Text, PersistValue)])
-> Map Text v
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, v) -> (Text, PersistValue))
-> [(Text, v)] -> [(Text, PersistValue)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> PersistValue) -> (Text, v) -> (Text, PersistValue)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second v -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue) ([(Text, v)] -> [(Text, PersistValue)])
-> (Map Text v -> [(Text, v)])
-> Map Text v
-> [(Text, PersistValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text v -> [(Text, v)]
forall k a. Map k a -> [(k, a)]
M.toList
    fromPersistValue :: PersistValue -> Either Text (Map Text v)
fromPersistValue = [(Text, PersistValue)] -> Either Text (Map Text v)
forall v.
PersistField v =>
[(Text, PersistValue)] -> Either Text (Map Text v)
fromPersistMap ([(Text, PersistValue)] -> Either Text (Map Text v))
-> (PersistValue -> Either Text [(Text, PersistValue)])
-> PersistValue
-> Either Text (Map Text v)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PersistValue -> Either Text [(Text, PersistValue)]
getPersistMap

instance PersistField PersistValue where
    toPersistValue :: PersistValue -> PersistValue
toPersistValue = PersistValue -> PersistValue
forall a. a -> a
id
    fromPersistValue :: PersistValue -> Either Text PersistValue
fromPersistValue = PersistValue -> Either Text PersistValue
forall a b. b -> Either a b
Right

fromPersistList :: PersistField a => [PersistValue] -> Either T.Text [a]
fromPersistList :: forall a. PersistField a => [PersistValue] -> Either Text [a]
fromPersistList = (PersistValue -> Either Text a)
-> [PersistValue] -> Either Text [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue

fromPersistMap :: PersistField v
               => [(T.Text, PersistValue)]
               -> Either T.Text (M.Map T.Text v)
fromPersistMap :: forall v.
PersistField v =>
[(Text, PersistValue)] -> Either Text (Map Text v)
fromPersistMap = (PersistValue -> Either Text v)
-> [(Text, v)]
-> [(Text, PersistValue)]
-> Either Text (Map Text v)
forall {a} {t} {a} {b}.
Ord a =>
(t -> Either a b) -> [(a, b)] -> [(a, t)] -> Either a (Map a b)
foldShortLeft PersistValue -> Either Text v
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue [] where
    -- a fold that short-circuits on Left.
    foldShortLeft :: (t -> Either a b) -> [(a, b)] -> [(a, t)] -> Either a (Map a b)
foldShortLeft t -> Either a b
f = [(a, b)] -> [(a, t)] -> Either a (Map a b)
go
      where
        go :: [(a, b)] -> [(a, t)] -> Either a (Map a b)
go [(a, b)]
acc [] = Map a b -> Either a (Map a b)
forall a b. b -> Either a b
Right (Map a b -> Either a (Map a b)) -> Map a b -> Either a (Map a b)
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(a, b)]
acc
        go [(a, b)]
acc ((a
k, t
v):[(a, t)]
kvs) =
          case t -> Either a b
f t
v of
            Left a
e   -> a -> Either a (Map a b)
forall a b. a -> Either a b
Left a
e
            Right b
v' -> [(a, b)] -> [(a, t)] -> Either a (Map a b)
go ((a
k,b
v')(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
acc) [(a, t)]
kvs

-- | FIXME Add documentation to that.
getPersistMap :: PersistValue -> Either T.Text [(T.Text, PersistValue)]
getPersistMap :: PersistValue -> Either Text [(Text, PersistValue)]
getPersistMap (PersistMap [(Text, PersistValue)]
kvs) = [(Text, PersistValue)] -> Either Text [(Text, PersistValue)]
forall a b. b -> Either a b
Right [(Text, PersistValue)]
kvs
getPersistMap (PersistText Text
t)  = PersistValue -> Either Text [(Text, PersistValue)]
getPersistMap (ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t)
getPersistMap (PersistByteString ByteString
bs)
    | Just [(Text, PersistValue)]
pairs <- ByteString -> Maybe [(Text, PersistValue)]
forall a. FromJSON a => ByteString -> Maybe a
A.decode' ([ByteString] -> ByteString
L.fromChunks [ByteString
bs]) = [(Text, PersistValue)] -> Either Text [(Text, PersistValue)]
forall a b. b -> Either a b
Right [(Text, PersistValue)]
pairs
getPersistMap PersistValue
PersistNull = [(Text, PersistValue)] -> Either Text [(Text, PersistValue)]
forall a b. b -> Either a b
Right []
getPersistMap PersistValue
x = Text -> Either Text [(Text, PersistValue)]
forall a b. a -> Either a b
Left (Text -> Either Text [(Text, PersistValue)])
-> Text -> Either Text [(Text, PersistValue)]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"[(Text, PersistValue)]" Text
"map, string, bytestring or null" PersistValue
x

instance PersistField Checkmark where
    toPersistValue :: Checkmark -> PersistValue
toPersistValue Checkmark
Active   = Bool -> PersistValue
PersistBool Bool
True
    toPersistValue Checkmark
Inactive = PersistValue
PersistNull
    fromPersistValue :: PersistValue -> Either Text Checkmark
fromPersistValue PersistValue
PersistNull         = Checkmark -> Either Text Checkmark
forall a b. b -> Either a b
Right Checkmark
Inactive
    fromPersistValue (PersistBool Bool
True)  = Checkmark -> Either Text Checkmark
forall a b. b -> Either a b
Right Checkmark
Active
    fromPersistValue (PersistInt64 Int64
1)    = Checkmark -> Either Text Checkmark
forall a b. b -> Either a b
Right Checkmark
Active
    fromPersistValue (PersistByteString ByteString
i) = case ByteString -> Maybe (Int, ByteString)
readInt ByteString
i of
                                               Just (Int
0,ByteString
"") -> Text -> Either Text Checkmark
forall a b. a -> Either a b
Left Text
"Failed to parse Haskell type `Checkmark`: found `0`, expected `1` or NULL"
                                               Just (Int
1,ByteString
"") -> Checkmark -> Either Text Checkmark
forall a b. b -> Either a b
Right Checkmark
Active
                                               Maybe (Int, ByteString)
xs -> Text -> Either Text Checkmark
forall a b. a -> Either a b
Left (Text -> Either Text Checkmark) -> Text -> Either Text Checkmark
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to parse Haskell type `Checkmark` from PersistByteString. Original value:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Parsed by `readInt` as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Maybe (Int, ByteString) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (Int, ByteString)
xs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Expected '1'."
    fromPersistValue (PersistBool Bool
False) =
      Text -> Either Text Checkmark
forall a b. a -> Either a b
Left (Text -> Either Text Checkmark) -> Text -> Either Text Checkmark
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
"PersistField Checkmark: found unexpected FALSE value"
    fromPersistValue PersistValue
other =
      Text -> Either Text Checkmark
forall a b. a -> Either a b
Left (Text -> Either Text Checkmark) -> Text -> Either Text Checkmark
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PersistValue -> Text
fromPersistValueError Text
"Checkmark" Text
"boolean, integer, bytestring or null" PersistValue
other


fromPersistValueError :: Text -- ^ Haskell type, should match Haskell name exactly, e.g. "Int64"
                      -> Text -- ^ Database type(s), should appear different from Haskell name, e.g. "integer" or "INT", not "Int".
                      -> PersistValue -- ^ Incorrect value
                      -> Text -- ^ Error message
fromPersistValueError :: Text -> Text -> PersistValue -> Text
fromPersistValueError Text
haskellType Text
databaseType PersistValue
received = [Text] -> Text
T.concat
    [ Text
"Failed to parse Haskell type `"
    , Text
haskellType
    , Text
"`; expected "
    , Text
databaseType
    , Text
" from database, but received: "
    , [Char] -> Text
T.pack (PersistValue -> [Char]
forall a. Show a => a -> [Char]
show PersistValue
received)
    , Text
". Potential solution: Check that your database schema matches your Persistent model definitions."
    ]

fromPersistValueParseError :: (Show a)
                           => Text -- ^ Haskell type, should match Haskell name exactly, e.g. "Int64"
                           -> a -- ^ Received value
                           -> Text -- ^ Error message
fromPersistValueParseError :: forall a. Show a => Text -> a -> Text
fromPersistValueParseError Text
haskellType a
received = [Text] -> Text
T.concat
    [ Text
"Failed to parse Haskell type `"
    , Text
haskellType
    , Text
"`, but received "
    , [Char] -> Text
T.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
received)
    ]