{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Autodocodec.Multipart where

import Autodocodec
import Data.Aeson as JSON
import Data.Aeson.Types as JSON
import qualified Data.ByteString.Lazy as LB
import Data.Foldable
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import Servant.Multipart as Servant
import Servant.Multipart.API as Servant

toMultipartViaCodec :: forall a tag. HasObjectCodec a => a -> MultipartData tag
toMultipartViaCodec :: forall a tag. HasObjectCodec a => a -> MultipartData tag
toMultipartViaCodec = forall a void tag. ObjectCodec a void -> a -> MultipartData tag
toMultipartVia (forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec @a)

toMultipartVia :: ObjectCodec a void -> a -> MultipartData tag
toMultipartVia :: forall a void tag. ObjectCodec a void -> a -> MultipartData tag
toMultipartVia = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go
  where
    go :: a -> ObjectCodec a void -> MultipartData tag
    go :: forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go a
a = \case
      BimapCodec oldOutput -> Either String void
_ a -> oldInput
to Codec Object oldInput oldOutput
c -> forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go (a -> oldInput
to a
a) Codec Object oldInput oldOutput
c
      EitherCodec Union
_ Codec Object input1 output1
c1 Codec Object input2 output2
c2 -> case a
a of
        Left input1
a1 -> forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go input1
a1 Codec Object input1 output1
c1
        Right input2
a2 -> forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go input2
a2 Codec Object input2 output2
c2
      DiscriminatedUnionCodec Text
discriminator a -> (Text, ObjectCodec a ())
encoding HashMap Text (Text, ObjectCodec Void void)
_ ->
        let (Text
discriminatorValue, ObjectCodec a ()
c) = a -> (Text, ObjectCodec a ())
encoding a
a
         in forall tag.
MultipartData tag -> MultipartData tag -> MultipartData tag
mappendMultipartData
              ( MultipartData
                  { inputs :: [Input]
inputs = [Text -> Text -> Input
Input Text
discriminator Text
discriminatorValue],
                    files :: [FileData tag]
files = []
                  }
              )
              (forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go a
a ObjectCodec a ()
c)
      RequiredKeyCodec Text
key ValueCodec a void
vc Maybe Text
_ ->
        MultipartData
          { inputs :: [Input]
inputs = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a void
vc),
            files :: [FileData tag]
files = []
          }
      OptionalKeyCodec Text
key ValueCodec input1 output1
vc Maybe Text
_ ->
        MultipartData
          { inputs :: [Input]
inputs = do
              input1
a' <- forall a. Maybe a -> [a]
maybeToList a
a
              Text
v <- forall a void. a -> ValueCodec a void -> [Text]
goValue input1
a' ValueCodec input1 output1
vc
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Input
Input Text
key Text
v,
            files :: [FileData tag]
files = []
          }
      OptionalKeyWithDefaultCodec Text
key ValueCodec a a
vc a
_ Maybe Text
_ ->
        MultipartData
          { inputs :: [Input]
inputs = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a a
vc),
            files :: [FileData tag]
files = []
          }
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec a a
vc a
defaultValue Maybe Text
_ ->
        MultipartData
          { inputs :: [Input]
inputs =
              if a
a forall a. Eq a => a -> a -> Bool
== a
defaultValue
                then []
                else forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a a
vc),
            files :: [FileData tag]
files = []
          }
      PureCodec void
_ -> forall tag. MultipartData tag
memptyMultipartData
      ApCodec ObjectCodec a (output1 -> void)
oc1 ObjectCodec a output1
oc2 -> forall tag.
MultipartData tag -> MultipartData tag -> MultipartData tag
mappendMultipartData (forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go a
a ObjectCodec a (output1 -> void)
oc1) (forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go a
a ObjectCodec a output1
oc2)

    goValue :: a -> ValueCodec a void -> [Text]
    goValue :: forall a void. a -> ValueCodec a void -> [Text]
goValue a
a = \case
      BimapCodec oldOutput -> Either String void
_ a -> oldInput
to Codec Value oldInput oldOutput
vc -> forall a void. a -> ValueCodec a void -> [Text]
goValue (a -> oldInput
to a
a) Codec Value oldInput oldOutput
vc
      EitherCodec Union
_ Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case a
a of
        Left input1
a1 -> forall a void. a -> ValueCodec a void -> [Text]
goValue input1
a1 Codec Value input1 output1
c1
        Right input2
a2 -> forall a void. a -> ValueCodec a void -> [Text]
goValue input2
a2 Codec Value input2 output2
c2
      CommentCodec Text
_ ValueCodec a void
vc -> forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a void
vc
      ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
vc -> forall a b. (a -> b) -> [a] -> [b]
map (forall a void. a -> ValueCodec a void -> Text
`goSingleValue` ValueCodec input1 output1
vc) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList a
a)
      ValueCodec a void
vc -> [forall a void. a -> ValueCodec a void -> Text
goSingleValue a
a ValueCodec a void
vc]

    goSingleValue :: a -> ValueCodec a void -> Text
    goSingleValue :: forall a void. a -> ValueCodec a void -> Text
goSingleValue a
a = \case
      BimapCodec oldOutput -> Either String void
_ a -> oldInput
to Codec Value oldInput oldOutput
vc -> forall a void. a -> ValueCodec a void -> Text
goSingleValue (a -> oldInput
to a
a) Codec Value oldInput oldOutput
vc
      EitherCodec Union
_ Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case a
a of
        Left input1
a1 -> forall a void. a -> ValueCodec a void -> Text
goSingleValue input1
a1 Codec Value input1 output1
c1
        Right input2
a2 -> forall a void. a -> ValueCodec a void -> Text
goSingleValue input2
a2 Codec Value input2 output2
c2
      CommentCodec Text
_ ValueCodec a void
vc -> forall a void. a -> ValueCodec a void -> Text
goSingleValue a
a ValueCodec a void
vc
      ValueCodec a void
NullCodec -> Text
"null"
      BoolCodec Maybe Text
_ ->
        case a
a of
          a
Bool
True -> Text
"True"
          a
Bool
False -> Text
"False"
      StringCodec Maybe Text
_ -> a
a
      ValueCodec a void
vc ->
        let value :: Value
value = forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec a void
vc a
a
         in case Value
value of
              JSON.String Text
t -> Text
t
              Value
_ -> ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
LB.toStrict (forall a. ToJSON a => a -> ByteString
JSON.encode Value
value))

memptyMultipartData :: MultipartData tag
memptyMultipartData :: forall tag. MultipartData tag
memptyMultipartData =
  MultipartData
    { inputs :: [Input]
inputs = [],
      files :: [FileData tag]
files = []
    }

mappendMultipartData :: MultipartData tag -> MultipartData tag -> MultipartData tag
mappendMultipartData :: forall tag.
MultipartData tag -> MultipartData tag -> MultipartData tag
mappendMultipartData MultipartData tag
mpd1 MultipartData tag
mpd2 =
  MultipartData
    { inputs :: [Input]
inputs = forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
mpd1 forall a. [a] -> [a] -> [a]
++ forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
mpd2,
      files :: [FileData tag]
files = forall tag. MultipartData tag -> [FileData tag]
files MultipartData tag
mpd1 forall a. [a] -> [a] -> [a]
++ forall tag. MultipartData tag -> [FileData tag]
files MultipartData tag
mpd2
    }

instance HasObjectCodec a => Servant.ToMultipart tag (Autodocodec a) where
  toMultipart :: Autodocodec a -> MultipartData tag
toMultipart = forall a tag. HasObjectCodec a => a -> MultipartData tag
toMultipartViaCodec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Autodocodec a -> a
unAutodocodec

fromMultipartViaCodec :: forall a tag. HasObjectCodec a => MultipartData tag -> Either String a
fromMultipartViaCodec :: forall a tag.
HasObjectCodec a =>
MultipartData tag -> Either String a
fromMultipartViaCodec = forall void a tag.
ObjectCodec void a -> MultipartData tag -> Either String a
fromMultipartVia (forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec @a)

fromMultipartVia :: ObjectCodec void a -> MultipartData tag -> Either String a
fromMultipartVia :: forall void a tag.
ObjectCodec void a -> MultipartData tag -> Either String a
fromMultipartVia = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go
  where
    go :: MultipartData tag -> ObjectCodec void a -> Either String a
    go :: forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd = \case
      BimapCodec oldOutput -> Either String a
from void -> oldInput
_ Codec Object oldInput oldOutput
c -> forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object oldInput oldOutput
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= oldOutput -> Either String a
from
      EitherCodec Union
u Codec Object input1 output1
c1 Codec Object input2 output2
c2 -> case Union
u of
        Union
PossiblyJointUnion ->
          case forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object input1 output1
c1 of
            Right output1
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object input2 output2
c2 of
              Left String
err2 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " forall a. Semigroup a => a -> a -> a
<> String
err1 forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case (forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object input1 output1
c1, forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object input2 output2
c2) of
            (Left String
_, Right output2
r) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
                [String] -> String
unlines
                  [ String
"Both branches of a disjoint union failed: ",
                    [String] -> String
unwords [String
"Left:  ", String
lErr],
                    [String] -> String
unwords [String
"Right: ", String
rErr]
                  ]
      DiscriminatedUnionCodec Text
discriminator void -> (Text, ObjectCodec void ())
_ HashMap Text (Text, ObjectCodec Void a)
m -> do
        Text
discriminatorValue <- forall tag. Text -> MultipartData tag -> Either String Text
lookupInput Text
discriminator MultipartData tag
mpd
        case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
discriminatorValue HashMap Text (Text, ObjectCodec Void a)
m of
          Maybe (Text, ObjectCodec Void a)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unexpected discriminator value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
discriminatorValue
          Just (Text
_, ObjectCodec Void a
c) -> forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd ObjectCodec Void a
c
      RequiredKeyCodec Text
key ValueCodec void a
vc Maybe Text
_ -> do
        [Text]
values <- forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec void a
vc
      OptionalKeyCodec Text
key ValueCodec input1 output1
vc Maybe Text
_ -> do
        [Text]
values <- forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        case [Text]
values of
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
          [Text]
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec input1 output1
vc
      OptionalKeyWithDefaultCodec Text
key ValueCodec void void
vc void
defaultValue Maybe Text
_ -> do
        [Text]
values <- forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        case [Text]
values of
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure void
defaultValue
          [Text]
_ -> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec void void
vc
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec void void
vc void
defaultValue Maybe Text
_ -> do
        [Text]
values <- forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        case [Text]
values of
          [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure void
defaultValue
          [Text]
_ -> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec void void
vc
      PureCodec a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
      ApCodec ObjectCodec void (output1 -> a)
ocf ObjectCodec void output1
oca -> forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd ObjectCodec void (output1 -> a)
ocf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd ObjectCodec void output1
oca

    goValue :: [Text] -> ValueCodec void a -> Either String a
    goValue :: forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts = \case
      BimapCodec oldOutput -> Either String a
from void -> oldInput
_ Codec Value oldInput oldOutput
c -> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value oldInput oldOutput
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= oldOutput -> Either String a
from
      EitherCodec Union
u Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case Union
u of
        Union
PossiblyJointUnion ->
          case forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input1 output1
c1 of
            Right output1
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input2 output2
c2 of
              Left String
err2 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " forall a. Semigroup a => a -> a -> a
<> String
err1 forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case (forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input1 output1
c1, forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input2 output2
c2) of
            (Left String
_, Right output2
r) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
                [String] -> String
unlines
                  [ String
"Both branches of a disjoint union failed: ",
                    [String] -> String
unwords [String
"Left:  ", String
lErr],
                    [String] -> String
unwords [String
"Right: ", String
rErr]
                  ]
      ReferenceCodec Text
_ ValueCodec void a
vc -> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts ValueCodec void a
vc
      CommentCodec Text
_ ValueCodec void a
c -> forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts ValueCodec void a
c
      ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
vc -> forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall void a. Text -> ValueCodec void a -> Either String a
`goSingleValue` ValueCodec input1 output1
vc) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Text]
ts)
      ValueCodec void a
vc -> case [Text]
ts of
        [Text
t] -> forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
vc
        [Text]
_ -> forall a b. a -> Either a b
Left String
"Expected exactly one value."

    goSingleValue :: Text -> ValueCodec void a -> Either String a
    goSingleValue :: forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t = \case
      BimapCodec oldOutput -> Either String a
from void -> oldInput
_ Codec Value oldInput oldOutput
c -> forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value oldInput oldOutput
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= oldOutput -> Either String a
from
      EitherCodec Union
u Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case Union
u of
        Union
PossiblyJointUnion ->
          case forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input1 output1
c1 of
            Right output1
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input2 output2
c2 of
              Left String
err2 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " forall a. Semigroup a => a -> a -> a
<> String
err1 forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case (forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input1 output1
c1, forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input2 output2
c2) of
            (Left String
_, Right output2
r) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
                [String] -> String
unlines
                  [ String
"Both branches of a disjoint union failed: ",
                    [String] -> String
unwords [String
"Left:  ", String
lErr],
                    [String] -> String
unwords [String
"Right: ", String
rErr]
                  ]
      CommentCodec Text
_ ValueCodec void a
c -> forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
c
      ReferenceCodec Text
_ ValueCodec void a
vc -> forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
vc
      ValueCodec void a
NullCodec -> case Text
t of
        Text
"null" -> forall a b. b -> Either a b
Right ()
        Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"not 'null': " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
      BoolCodec Maybe Text
_ -> case Text
t of
        Text
"false" -> forall a b. b -> Either a b
Right Bool
False
        Text
"False" -> forall a b. b -> Either a b
Right Bool
False
        Text
"true" -> forall a b. b -> Either a b
Right Bool
True
        Text
"True" -> forall a b. b -> Either a b
Right Bool
True
        Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unknown bool: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t
      StringCodec Maybe Text
_ -> forall a b. b -> Either a b
Right Text
t
      ValueCodec void a
vc -> case forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither (forall void a. ValueCodec void a -> Value -> Parser a
parseJSONVia ValueCodec void a
vc) (Text -> Value
JSON.String Text
t) of
        Right a
a -> forall a b. b -> Either a b
Right a
a
        Left String
_ -> do
          Value
value <- forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode (ByteString -> ByteString
LB.fromStrict (Text -> ByteString
TE.encodeUtf8 Text
t))
          forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither (forall void a. ValueCodec void a -> Value -> Parser a
parseJSONVia ValueCodec void a
vc) Value
value

lookupMInput :: Text -> MultipartData tag -> Either String (Maybe Text)
lookupMInput :: forall tag. Text -> MultipartData tag -> Either String (Maybe Text)
lookupMInput Text
iname = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Input -> Text
iValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Text
iname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Text
iName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tag. MultipartData tag -> [Input]
inputs

lookupLInput :: Text -> MultipartData tag -> Either String [Text]
lookupLInput :: forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
iname = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Input -> Text
iValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Text
iname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Text
iName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tag. MultipartData tag -> [Input]
inputs

instance HasObjectCodec a => Servant.FromMultipart tag (Autodocodec a) where
  fromMultipart :: MultipartData tag -> Either String (Autodocodec a)
fromMultipart = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Autodocodec a
Autodocodec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a tag.
HasObjectCodec a =>
MultipartData tag -> Either String a
fromMultipartViaCodec