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

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

module Data.RdsData.Decode.Array
  ( DecodeArray(..)

  , decodeArrayFailedMessage

  , arrays
  , bools
  , doubles
  , integers
  , texts

  , ints
  , int8s
  , int16s
  , int32s
  , int64s
  , words
  , word8s
  , word16s
  , word32s
  , word64s
  , lazyTexts
  , strings
  , jsons
  , timesOfDay
  , utcTimes
  , days
  , uuids
  ) where

import Control.Applicative
import Data.Int
import Data.RdsData.Internal.Aeson
import Data.RdsData.Types.Array
import Data.Text (Text)
import Data.Time
import Data.UUID (UUID)
import Data.Word
import Prelude hiding (maybe, null, words)

import qualified Data.Aeson         as J
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 DecodeArray a = DecodeArray
  { forall a. DecodeArray a -> Array -> Either Text a
decodeArray :: Array -> Either Text a
  } deriving (forall a b. (a -> b) -> DecodeArray a -> DecodeArray b)
-> (forall a b. a -> DecodeArray b -> DecodeArray a)
-> Functor DecodeArray
forall a b. a -> DecodeArray b -> DecodeArray a
forall a b. (a -> b) -> DecodeArray a -> DecodeArray 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) -> DecodeArray a -> DecodeArray b
fmap :: forall a b. (a -> b) -> DecodeArray a -> DecodeArray b
$c<$ :: forall a b. a -> DecodeArray b -> DecodeArray a
<$ :: forall a b. a -> DecodeArray b -> DecodeArray a
Functor

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

instance Alternative DecodeArray where
  empty :: forall a. DecodeArray a
empty = (Array -> Either Text a) -> DecodeArray a
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"empty"
  DecodeArray Array -> Either Text a
a <|> :: forall a. DecodeArray a -> DecodeArray a -> DecodeArray a
<|> DecodeArray Array -> Either Text a
b = (Array -> Either Text a) -> DecodeArray a
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
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 (Array -> Either Text a
b Array
v)) a -> Either Text a
forall a b. b -> Either a b
Right (Array -> Either Text a
a Array
v)

instance Monad DecodeArray where
  DecodeArray Array -> Either Text a
a >>= :: forall a b. DecodeArray a -> (a -> DecodeArray b) -> DecodeArray b
>>= a -> DecodeArray b
f = (Array -> Either Text b) -> DecodeArray b
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v -> do
    a
a' <- Array -> Either Text a
a Array
v
    DecodeArray b -> Array -> Either Text b
forall a. DecodeArray a -> Array -> Either Text a
decodeArray (a -> DecodeArray b
f a
a') Array
v

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

decodeArrayFailedMessage :: Text -> Text -> Maybe Text -> Array -> Text
decodeArrayFailedMessage :: Text -> Text -> Maybe Text -> Array -> Text
decodeArrayFailedMessage Text
item Text
type_ Maybe Text
reason Array
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 Array of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Array -> Text
forall a. ToJSON a => a -> Text
toJsonText Array
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
    ]

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

integers :: DecodeArray [Integer]
integers :: DecodeArray [Integer]
integers =
  (Array -> Either Text [Integer]) -> DecodeArray [Integer]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v ->
    case Array
v of
      ArrayOfIntegers [Integer]
es -> [Integer] -> Either Text [Integer]
forall a b. b -> Either a b
Right [Integer]
es
      Array
_ -> 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 -> Array -> Text
decodeArrayFailedMessage Text
"integers" Text
"ArrayOfIntegers" Maybe Text
forall a. Maybe a
Nothing Array
v

texts :: DecodeArray [Text]
texts :: DecodeArray [Text]
texts =
  (Array -> Either Text [Text]) -> DecodeArray [Text]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v ->
    case Array
v of
      ArrayOfTexts [Text]
es -> [Text] -> Either Text [Text]
forall a b. b -> Either a b
Right [Text]
es
      Array
_ -> 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 -> Array -> Text
decodeArrayFailedMessage Text
"texts" Text
"ArrayOfStrings" Maybe Text
forall a. Maybe a
Nothing Array
v

bools :: DecodeArray [Bool]
bools :: DecodeArray [Bool]
bools =
  (Array -> Either Text [Bool]) -> DecodeArray [Bool]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v ->
    case Array
v of
      ArrayOfBools [Bool]
es -> [Bool] -> Either Text [Bool]
forall a b. b -> Either a b
Right [Bool]
es
      Array
_ -> 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 -> Array -> Text
decodeArrayFailedMessage Text
"bools" Text
"ArrayOfBooleans" Maybe Text
forall a. Maybe a
Nothing Array
v

doubles :: DecodeArray [Double]
doubles :: DecodeArray [Double]
doubles =
  (Array -> Either Text [Double]) -> DecodeArray [Double]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v ->
    case Array
v of
      ArrayOfDoubles [Double]
es -> [Double] -> Either Text [Double]
forall a b. b -> Either a b
Right [Double]
es
      Array
_ -> 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 -> Array -> Text
decodeArrayFailedMessage Text
"doubles" Text
"ArrayOfDoubles" Maybe Text
forall a. Maybe a
Nothing Array
v

arrays :: DecodeArray [Array]
arrays :: DecodeArray [Array]
arrays =
  (Array -> Either Text [Array]) -> DecodeArray [Array]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
v ->
    case Array
v of
      ArrayOfArrays [Array]
es -> [Array] -> Either Text [Array]
forall a b. b -> Either a b
Right [Array]
es
      Array
_ -> Text -> Either Text [Array]
forall a b. a -> Either a b
Left (Text -> Either Text [Array]) -> Text -> Either Text [Array]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Array -> Text
decodeArrayFailedMessage Text
"arrays" Text
"ArrayOfArrays" Maybe Text
forall a. Maybe a
Nothing Array
v

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

ints :: DecodeArray [Int]
ints :: DecodeArray [Int]
ints =
  (Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int]) -> DecodeArray [Integer] -> DecodeArray [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

int8s :: DecodeArray [Int8]
int8s :: DecodeArray [Int8]
int8s =
  (Integer -> Int8) -> [Integer] -> [Int8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int8])
-> DecodeArray [Integer] -> DecodeArray [Int8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

int16s :: DecodeArray [Int16]
int16s :: DecodeArray [Int16]
int16s =
  (Integer -> Int16) -> [Integer] -> [Int16]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int16])
-> DecodeArray [Integer] -> DecodeArray [Int16]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

int32s :: DecodeArray [Int32]
int32s :: DecodeArray [Int32]
int32s =
  (Integer -> Int32) -> [Integer] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int32])
-> DecodeArray [Integer] -> DecodeArray [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

int64s :: DecodeArray [Int64]
int64s :: DecodeArray [Int64]
int64s =
  (Integer -> Int64) -> [Integer] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Int64])
-> DecodeArray [Integer] -> DecodeArray [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

words :: DecodeArray [Word]
words :: DecodeArray [Word]
words =
  (Integer -> Word) -> [Integer] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word])
-> DecodeArray [Integer] -> DecodeArray [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

word8s :: DecodeArray [Word8]
word8s :: DecodeArray [Word8]
word8s =
  (Integer -> Word8) -> [Integer] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word8])
-> DecodeArray [Integer] -> DecodeArray [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

word16s :: DecodeArray [Word16]
word16s :: DecodeArray [Word16]
word16s =
  (Integer -> Word16) -> [Integer] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word16])
-> DecodeArray [Integer] -> DecodeArray [Word16]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

word32s :: DecodeArray [Word32]
word32s :: DecodeArray [Word32]
word32s =
  (Integer -> Word32) -> [Integer] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word32])
-> DecodeArray [Integer] -> DecodeArray [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

word64s :: DecodeArray [Word64]
word64s :: DecodeArray [Word64]
word64s =
  (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Word64])
-> DecodeArray [Integer] -> DecodeArray [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Integer]
integers

lazyTexts :: DecodeArray [LT.Text]
lazyTexts :: DecodeArray [Text]
lazyTexts =
  (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
LT.fromStrict ([Text] -> [Text]) -> DecodeArray [Text] -> DecodeArray [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Text]
texts

strings :: DecodeArray [String]
strings :: DecodeArray [String]
strings =
  (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack ([Text] -> [String]) -> DecodeArray [Text] -> DecodeArray [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeArray [Text]
texts

jsons  :: DecodeArray [J.Value]
jsons :: DecodeArray [Value]
jsons = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Either String Value) -> [Text] -> Either String [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' (ByteString -> Either String Value)
-> (Text -> ByteString) -> Text -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) [Text]
ts of
    Right [Value]
js -> [Value] -> DecodeArray [Value]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
js
    Left String
e -> (Array -> Either Text [Value]) -> DecodeArray [Value]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [Value]
forall a b. a -> Either a b
Left (Text -> Either Text [Value]) -> Text -> Either Text [Value]
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e

timesOfDay :: DecodeArray [TimeOfDay]
timesOfDay :: DecodeArray [TimeOfDay]
timesOfDay = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Maybe TimeOfDay) -> [Text] -> Maybe [TimeOfDay]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (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"(String -> Maybe TimeOfDay)
-> (Text -> String) -> Text -> Maybe TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
ts of
    Just [TimeOfDay]
tod -> [TimeOfDay] -> DecodeArray [TimeOfDay]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TimeOfDay]
tod
    Maybe [TimeOfDay]
Nothing -> (Array -> Either Text [TimeOfDay]) -> DecodeArray [TimeOfDay]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [TimeOfDay]
forall a b. a -> Either a b
Left Text
"Failed to decode TimeOfDay"

utcTimes :: DecodeArray [UTCTime]
utcTimes :: DecodeArray [UTCTime]
utcTimes = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Maybe UTCTime) -> [Text] -> Maybe [UTCTime]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (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" (String -> Maybe UTCTime)
-> (Text -> String) -> Text -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
ts of
    Just [UTCTime]
utct -> [UTCTime] -> DecodeArray [UTCTime]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [UTCTime]
utct
    Maybe [UTCTime]
Nothing -> (Array -> Either Text [UTCTime]) -> DecodeArray [UTCTime]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [UTCTime]
forall a b. a -> Either a b
Left Text
"Failed to decode UTCTime"

days :: DecodeArray [Day]
days :: DecodeArray [Day]
days = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Maybe Day) -> [Text] -> Maybe [Day]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (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" (String -> Maybe Day) -> (Text -> String) -> Text -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
ts of
    Just [Day]
d -> [Day] -> DecodeArray [Day]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Day]
d
    Maybe [Day]
Nothing -> (Array -> Either Text [Day]) -> DecodeArray [Day]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [Day]
forall a b. a -> Either a b
Left Text
"Failed to decode Day"

uuids :: DecodeArray [UUID]
uuids :: DecodeArray [UUID]
uuids = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Maybe UUID) -> [Text] -> Maybe [UUID]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (String -> Maybe UUID
UUID.fromString (String -> Maybe UUID) -> (Text -> String) -> Text -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
ts of
    Just [UUID]
u -> [UUID] -> DecodeArray [UUID]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [UUID]
u
    Maybe [UUID]
Nothing -> (Array -> Either Text [UUID]) -> DecodeArray [UUID]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [UUID]
forall a b. a -> Either a b
Left Text
"Failed to decode UUID"