{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}

{- HLINT ignore "Use <&>" -}

module Data.RdsData.Decode.Value
  ( DecodeValue(..)

  , rdsValue
  , decodeValueFailedMessage
  , decodeValueFailed
  , maybe
  , array
  , base64
  , bool
  , double
  , text
  , integer
  , null
  , int
  , int8
  , int16
  , int32
  , int64
  , word
  , word8
  , word16
  , word32
  , word64
  , bytestring
  , lazyText
  , lazyBytestring
  , string
  , json
  , timeOfDay
  , utcTime
  , uuid
  , day

  ) where

import Amazonka.Data.Base64
import Control.Applicative
import Data.ByteString (ByteString)
import Data.Int
import Data.RdsData.Decode.Array (DecodeArray(..))
import Data.RdsData.Internal.Aeson
import Data.RdsData.Types.Value
import Data.Text (Text)
import Data.Time
import Data.UUID (UUID)
import Data.Word
import Prelude hiding (maybe, null)

import qualified Amazonka.Data.ByteString       as AWS
import qualified Data.Aeson                     as J
import qualified Data.ByteString.Lazy           as LBS
import qualified Data.RdsData.Internal.Convert  as CONV
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as T
import qualified Data.Text.Lazy                 as LT
import qualified Data.UUID                      as UUID
import qualified Prelude                        as P

newtype DecodeValue a = DecodeValue
  { forall a. DecodeValue a -> Value -> Either Text a
decodeValue :: Value -> Either Text a
  } deriving (forall a b. (a -> b) -> DecodeValue a -> DecodeValue b)
-> (forall a b. a -> DecodeValue b -> DecodeValue a)
-> Functor DecodeValue
forall a b. a -> DecodeValue b -> DecodeValue a
forall a b. (a -> b) -> DecodeValue a -> DecodeValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DecodeValue a -> DecodeValue b
fmap :: forall a b. (a -> b) -> DecodeValue a -> DecodeValue b
$c<$ :: forall a b. a -> DecodeValue b -> DecodeValue a
<$ :: forall a b. a -> DecodeValue b -> DecodeValue a
Functor

instance Applicative DecodeValue where
  pure :: forall a. a -> DecodeValue a
pure a
a = (Value -> Either Text a) -> DecodeValue a
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
_ -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
  DecodeValue Value -> Either Text (a -> b)
f <*> :: forall a b. DecodeValue (a -> b) -> DecodeValue a -> DecodeValue b
<*> DecodeValue Value -> Either Text a
a = (Value -> Either Text b) -> DecodeValue b
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v -> Value -> Either Text (a -> b)
f Value
v Either Text (a -> b) -> Either Text a -> Either Text 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
<*> Value -> Either Text a
a Value
v

instance Alternative DecodeValue where
  empty :: forall a. DecodeValue a
empty = (Value -> Either Text a) -> DecodeValue a
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"empty"
  DecodeValue Value -> Either Text a
a <|> :: forall a. DecodeValue a -> DecodeValue a -> DecodeValue a
<|> DecodeValue Value -> Either Text a
b = (Value -> Either Text a) -> DecodeValue a
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    (Text -> Either Text a)
-> (a -> Either Text a) -> Either Text a -> Either Text a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Text a -> Text -> Either Text a
forall a b. a -> b -> a
const (Value -> Either Text a
b Value
v)) a -> Either Text a
forall a b. b -> Either a b
Right (Value -> Either Text a
a Value
v)

instance Monad DecodeValue where
  DecodeValue Value -> Either Text a
a >>= :: forall a b. DecodeValue a -> (a -> DecodeValue b) -> DecodeValue b
>>= a -> DecodeValue b
f = (Value -> Either Text b) -> DecodeValue b
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v -> do
    a
a' <- Value -> Either Text a
a Value
v
    DecodeValue b -> Value -> Either Text b
forall a. DecodeValue a -> Value -> Either Text a
decodeValue (a -> DecodeValue b
f a
a') Value
v

--------------------------------------------------------------------------------

rdsValue :: DecodeValue Value
rdsValue :: DecodeValue Value
rdsValue =
  (Value -> Either Text Value) -> DecodeValue Value
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue Value -> Either Text Value
forall a b. b -> Either a b
Right

decodeValueFailedMessage :: Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage :: Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
item Text
type_ Maybe Text
reason Value
value =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Failed to decode " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
item Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
type_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from Value of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a. ToJSON a => a -> Text
toJsonText Value
value
    , Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe Text
"" (Text
" because " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
reason
    ]

decodeValueFailed :: Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed :: forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
value Text
type_ Maybe Text
reason =
  (Value -> Either Text a) -> DecodeValue a
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue ((Value -> Either Text a) -> DecodeValue a)
-> (Value -> Either Text a) -> DecodeValue a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a)
-> (Value -> Text) -> Value -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
value Text
type_ Maybe Text
reason

--------------------------------------------------------------------------------

maybe :: DecodeValue a -> DecodeValue (Maybe a)
maybe :: forall a. DecodeValue a -> DecodeValue (Maybe a)
maybe (DecodeValue Value -> Either Text a
f) =
  (Value -> Either Text (Maybe a)) -> DecodeValue (Maybe a)
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      Value
ValueOfNull -> Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
      Value
_ -> 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
<$> Value -> Either Text a
f Value
v  

--------------------------------------------------------------------------------

array :: DecodeArray a -> DecodeValue a
array :: forall a. DecodeArray a -> DecodeValue a
array DecodeArray a
decoder =
  (Value -> Either Text a) -> DecodeValue a
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfArray Array
a -> DecodeArray a -> Array -> Either Text a
forall a. DecodeArray a -> Array -> Either Text a
decodeArray DecodeArray a
decoder Array
a
      Value
_ -> 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 -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"array" Text
"Array" Maybe Text
forall a. Maybe a
Nothing Value
v

base64 :: DecodeValue Base64
base64 :: DecodeValue Base64
base64 =
  (Value -> Either Text Base64) -> DecodeValue Base64
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfBase64 Base64
b64 -> Base64 -> Either Text Base64
forall a b. b -> Either a b
Right Base64
b64
      Value
_ -> Text -> Either Text Base64
forall a b. a -> Either a b
Left (Text -> Either Text Base64) -> Text -> Either Text Base64
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"base64" Text
"Base64" Maybe Text
forall a. Maybe a
Nothing Value
v

bool :: DecodeValue Bool
bool :: DecodeValue Bool
bool =
  (Value -> Either Text Bool) -> DecodeValue Bool
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfBool Bool
b -> Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
b
      Value
_ -> 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 -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"bool" Text
"Bool" Maybe Text
forall a. Maybe a
Nothing Value
v

double :: DecodeValue Double
double :: DecodeValue Double
double =
  (Value -> Either Text Double) -> DecodeValue Double
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfDouble Double
n -> Double -> Either Text Double
forall a b. b -> Either a b
Right Double
n
      ValueOfText Text
t ->
        case Text -> Maybe Double
CONV.textToDouble Text
t of
          Just Double
n -> Double -> Either Text Double
forall a b. b -> Either a b
Right Double
n
          Maybe Double
Nothing -> 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 -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"double" Text
"Double" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"failed to parse text as double") Value
v
      Value
_ -> 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 -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"double" Text
"Double" Maybe Text
forall a. Maybe a
Nothing Value
v

text :: DecodeValue Text
text :: DecodeValue Text
text =
  (Value -> Either Text Text) -> DecodeValue Text
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfText Text
s -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
s
      Value
_ -> Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"text" Text
"Text" Maybe Text
forall a. Maybe a
Nothing Value
v

integer :: DecodeValue Integer
integer :: DecodeValue Integer
integer =
  (Value -> Either Text Integer) -> DecodeValue Integer
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      ValueOfInteger Integer
n -> Integer -> Either Text Integer
forall a b. b -> Either a b
Right Integer
n
      Value
_ -> Text -> Either Text Integer
forall a b. a -> Either a b
Left (Text -> Either Text Integer) -> Text -> Either Text Integer
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"integer" Text
"Integer" Maybe Text
forall a. Maybe a
Nothing Value
v

null :: DecodeValue ()
null :: DecodeValue ()
null =
  (Value -> Either Text ()) -> DecodeValue ()
forall a. (Value -> Either Text a) -> DecodeValue a
DecodeValue \Value
v ->
    case Value
v of
      Value
ValueOfNull -> () -> Either Text ()
forall a b. b -> Either a b
Right ()
      Value
_ -> Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Value -> Text
decodeValueFailedMessage Text
"null" Text
"()" Maybe Text
forall a. Maybe a
Nothing Value
v

--------------------------------------------------------------------------------

int :: DecodeValue Int
int :: DecodeValue Int
int =
  [DecodeValue Int] -> DecodeValue Int
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> DecodeValue Int64 -> DecodeValue Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Int64
int64
    , Text -> Text -> Maybe Text -> DecodeValue Int
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"int" Text
"Int" Maybe Text
forall a. Maybe a
Nothing
    ]

int8 :: DecodeValue Int8
int8 :: DecodeValue Int8
int8 =
  [DecodeValue Int8] -> DecodeValue Int8
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int8) -> DecodeValue Integer -> DecodeValue Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Int8
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"int8" Text
"Int8" Maybe Text
forall a. Maybe a
Nothing
    ]

int16 :: DecodeValue Int16
int16 :: DecodeValue Int16
int16 =
  [DecodeValue Int16] -> DecodeValue Int16
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> DecodeValue Integer -> DecodeValue Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Int16
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"int16" Text
"Int16" Maybe Text
forall a. Maybe a
Nothing
    ]

int32 :: DecodeValue Int32
int32 :: DecodeValue Int32
int32 =
  [DecodeValue Int32] -> DecodeValue Int32
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> DecodeValue Integer -> DecodeValue Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Int32
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"int32" Text
"Int32" Maybe Text
forall a. Maybe a
Nothing
    ]

int64 :: DecodeValue Int64
int64 :: DecodeValue Int64
int64 =
  [DecodeValue Int64] -> DecodeValue Int64
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> DecodeValue Integer -> DecodeValue Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Int64
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"int64" Text
"Int64" Maybe Text
forall a. Maybe a
Nothing
    ]

word :: DecodeValue Word
word :: DecodeValue Word
word =
  [DecodeValue Word] -> DecodeValue Word
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word) -> DecodeValue Integer -> DecodeValue Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Word
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"word" Text
"Word" Maybe Text
forall a. Maybe a
Nothing
    ]

word8 :: DecodeValue Word8
word8 :: DecodeValue Word8
word8 =
  [DecodeValue Word8] -> DecodeValue Word8
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8) -> DecodeValue Integer -> DecodeValue Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Word8
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"word8" Text
"Word8" Maybe Text
forall a. Maybe a
Nothing
    ]

word16 :: DecodeValue Word16
word16 :: DecodeValue Word16
word16 =
  [DecodeValue Word16] -> DecodeValue Word16
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16) -> DecodeValue Integer -> DecodeValue Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Word16
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"word16" Text
"Word16" Maybe Text
forall a. Maybe a
Nothing
    ]

word32 :: DecodeValue Word32
word32 :: DecodeValue Word32
word32 =
  [DecodeValue Word32] -> DecodeValue Word32
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> DecodeValue Integer -> DecodeValue Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Word32
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"word32" Text
"Word32" Maybe Text
forall a. Maybe a
Nothing
    ]

word64 :: DecodeValue Word64
word64 :: DecodeValue Word64
word64 =
  [DecodeValue Word64] -> DecodeValue Word64
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> DecodeValue Integer -> DecodeValue Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Integer
integer
    , Text -> Text -> Maybe Text -> DecodeValue Word64
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"word64" Text
"Word64" Maybe Text
forall a. Maybe a
Nothing
    ]

bytestring :: DecodeValue ByteString
bytestring :: DecodeValue ByteString
bytestring =
  Base64 -> ByteString
forall a. ToByteString a => a -> ByteString
AWS.toBS (Base64 -> ByteString)
-> DecodeValue Base64 -> DecodeValue ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Base64
base64

lazyText :: DecodeValue LT.Text
lazyText :: DecodeValue Text
lazyText =
  Text -> Text
LT.fromStrict (Text -> Text) -> DecodeValue Text -> DecodeValue Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Text
text

lazyBytestring :: DecodeValue LBS.ByteString
lazyBytestring :: DecodeValue ByteString
lazyBytestring =
  ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> DecodeValue ByteString -> DecodeValue ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue ByteString
bytestring

string :: DecodeValue String
string :: DecodeValue String
string =
  Text -> String
T.unpack (Text -> String) -> DecodeValue Text -> DecodeValue String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeValue Text
text

json :: DecodeValue J.Value
json :: DecodeValue Value
json = do
  Text
t <- DecodeValue Text
text
  case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (ByteString -> ByteString
LBS.fromStrict (Text -> ByteString
T.encodeUtf8 Text
t)) of
    Right Value
v -> Value -> DecodeValue Value
forall a. a -> DecodeValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
    Left String
e -> Text -> Text -> Maybe Text -> DecodeValue Value
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"json" Text
"Value" (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
e))

timeOfDay :: DecodeValue TimeOfDay
timeOfDay :: DecodeValue TimeOfDay
timeOfDay = do
  Text
t <- DecodeValue Text
text
  case Bool -> TimeLocale -> String -> String -> Maybe TimeOfDay
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%H:%M:%S%Q" (Text -> String
T.unpack Text
t) of
    Just TimeOfDay
a -> TimeOfDay -> DecodeValue TimeOfDay
forall a. a -> DecodeValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
a
    Maybe TimeOfDay
Nothing -> Text -> Text -> Maybe Text -> DecodeValue TimeOfDay
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"timeOfDay" Text
"TimeOfDay" (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
t)))

utcTime :: DecodeValue UTCTime
utcTime :: DecodeValue UTCTime
utcTime = do
  Text
t <- DecodeValue Text
text
  case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d %H:%M:%S" (Text -> String
T.unpack Text
t) of
    Just UTCTime
a -> UTCTime -> DecodeValue UTCTime
forall a. a -> DecodeValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
a
    Maybe UTCTime
Nothing -> Text -> Text -> Maybe Text -> DecodeValue UTCTime
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"utcTime" Text
"UTCTime" Maybe Text
forall a. Maybe a
Nothing

uuid :: DecodeValue UUID
uuid :: DecodeValue UUID
uuid = do
  Text
t <- DecodeValue Text
text
  case String -> Maybe UUID
UUID.fromString (Text -> String
T.unpack Text
t) of
    Just UUID
a -> UUID -> DecodeValue UUID
forall a. a -> DecodeValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
a
    Maybe UUID
Nothing -> Text -> Text -> Maybe Text -> DecodeValue UUID
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"uuid" Text
"UUID" Maybe Text
forall a. Maybe a
Nothing

day :: DecodeValue Day
day :: DecodeValue Day
day = do
  Text
t <- DecodeValue Text
text
  case Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d" (Text -> String
T.unpack Text
t) of
    Just Day
a -> Day -> DecodeValue Day
forall a. a -> DecodeValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
a
    Maybe Day
Nothing -> Text -> Text -> Maybe Text -> DecodeValue Day
forall a. Text -> Text -> Maybe Text -> DecodeValue a
decodeValueFailed Text
"day" Text
"Day" Maybe Text
forall a. Maybe a
Nothing