{-# 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

  , days
  , int16s
  , int32s
  , int64s
  , int8s
  , ints
  , jsons
  , lazyTexts
  , strings
  , timesOfDay
  , ulids
  , utcTimes
  , uuids
  , word16s
  , word32s
  , word64s
  , word8s
  , words
  ) 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.ULID (ULID)
import Data.UUID (UUID)
import Data.Word
import Prelude hiding (maybe, null, words)

import qualified Data.Aeson                    as J
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 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"

-- | Decode an array of ULIDs
-- ULIDs are encoded as strings in the database and have have better database performance
-- than UUIDs stored as strings in the database.
ulids :: DecodeArray [ULID]
ulids :: DecodeArray [ULID]
ulids = do
  [Text]
ts <- DecodeArray [Text]
texts
  case (Text -> Either Text ULID) -> [Text] -> Either Text [ULID]
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 Text -> Either Text ULID
CONV.textToUlid [Text]
ts of
    Right [ULID]
u -> [ULID] -> DecodeArray [ULID]
forall a. a -> DecodeArray a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ULID]
u
    Left Text
msg -> (Array -> Either Text [ULID]) -> DecodeArray [ULID]
forall a. (Array -> Either Text a) -> DecodeArray a
DecodeArray \Array
_ -> Text -> Either Text [ULID]
forall a b. a -> Either a b
Left (Text -> Either Text [ULID]) -> Text -> Either Text [ULID]
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode UUID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg

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"