    {-# 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 qualified Data.Aeson as A
    import Data.ByteString.Char8 (ByteString, unpack, readInt)
    import qualified Data.ByteString.Lazy as L
    import Data.Fixed
    import Data.Foldable (asum)
    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 = PersistValue -> Either Text UTCTime
    utcTimeFromPersistValue

    #ifdef HIGH_PRECISION_DATE
    utcTimeFromPersistValue :: PersistValue -> Either Text UTCTime
    utcTimeFromPersistValue  (PersistUTCTime d) = Right d
    utcTimeFromPersistValue (PersistInt64 i)  = Right $ posixSecondsToUTCTime $ (/ (1000 * 1000 * 1000)) $ fromIntegral $ i
    utcTimeFromPersistValue (PersistText t)  = utcTimeFromPersistText t
    utcTimeFromPersistValue x@(PersistByteString s) =
            case reads $ unpack s of
                (d, _):_ -> Right d
                _ -> Left $ fromPersistValueParseError "UTCTime" x
    utcTimeFromPersistValue x = Left $ fromPersistValueError "UTCTime" "time, integer, string, or bytestring" x
    #else
    utcTimeFromPersistValue :: PersistValue -> Either Text UTCTime
    utcTimeFromPersistValue :: PersistValue -> Either Text UTCTime
    utcTimeFromPersistValue  (PersistUTCTime UTCTime
    d) = UTCTime -> Either Text UTCTime
    forall a b. b -> Either a b
    Right UTCTime
    d
    utcTimeFromPersistValue (PersistText Text
    t)  = Text -> Either Text UTCTime
    utcTimeFromPersistText Text
    t
    utcTimeFromPersistValue 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
    utcTimeFromPersistValue 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
    #endif

    utcTimeFromPersistText :: Text -> Either Text UTCTime
    utcTimeFromPersistText :: Text -> Either Text UTCTime
    utcTimeFromPersistText  Text
    t =
            let x :: PersistValue
    x = Text -> PersistValue
    PersistText Text
    t
                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 [Maybe UTCTime] -> Maybe UTCTime
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum [[Char] -> Maybe UTCTime
    parse8601 [Char]
    s, [Char] -> Maybe UTCTime
    parse8601NoTimezone [Char]
    s, [Char] -> Maybe UTCTime
    parsePretty [Char]
    s, [Char] -> Maybe UTCTime
    parsePrettyNoTimezone [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
            parse8601 :: [Char] -> Maybe UTCTime
    parse8601 = [Char] -> [Char] -> Maybe UTCTime
    parseTime' [Char]
    "%FT%T%QZ"
            parsePretty :: [Char] -> Maybe UTCTime
    parsePretty = [Char] -> [Char] -> Maybe UTCTime
    parseTime' [Char]
    "%F %T%QZ"
            -- Before 2.13.3.1 persistent-sqlite was missing the timezone "Z" for UTC,
            -- which was only implicit, so these functions ensure backwards-compatibility.
            parse8601NoTimezone :: [Char] -> Maybe UTCTime
    parse8601NoTimezone = [Char] -> [Char] -> Maybe UTCTime
    parseTime' [Char]
    "%FT%T%Q"
            parsePrettyNoTimezone :: [Char] -> Maybe UTCTime
    parsePrettyNoTimezone = [Char] -> [Char] -> Maybe UTCTime
    parseTime' [Char]
    "%F %T%Q"

    #if MIN_VERSION_time(1,5,0)
    parseTime' :: String -> String -> Maybe UTCTime
    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' :: String -> String -> Maybe UTCTime
    parseTime' = parseTime defaultTimeLocale
    #endif

    -- | 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)
        ]