{-# 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.Coerce (coerce)
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 Data.Vector (Vector)
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 = ObjectCodec a a -> a -> MultipartData tag
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 = (a -> ObjectCodec a void -> MultipartData tag)
-> ObjectCodec a void -> a -> MultipartData tag
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ObjectCodec a void -> MultipartData tag
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 -> oldInput -> Codec Object oldInput oldOutput -> MultipartData tag
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 -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a of
        Left input1
a1 -> input1 -> Codec Object input1 output1 -> MultipartData tag
forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go input1
a1 Codec Object input1 output1
c1
        Right input2
a2 -> input2 -> Codec Object input2 output2 -> MultipartData tag
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 MultipartData tag -> MultipartData tag -> MultipartData tag
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 = []
                  }
              )
              (a -> ObjectCodec a () -> MultipartData tag
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 = (Text -> Input) -> [Text] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (a -> ValueCodec a void -> [Text]
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' <- Maybe input1 -> [input1]
forall a. Maybe a -> [a]
maybeToList (Maybe input1 -> [input1]) -> Maybe input1 -> [input1]
forall a b. (a -> b) -> a -> b
$ a -> Maybe input1
forall a b. Coercible a b => a -> b
coerce a
a
              Text
v <- input1 -> ValueCodec input1 output1 -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue input1
a' ValueCodec input1 output1
vc
              Input -> [Input]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> [Input]) -> Input -> [Input]
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 = (Text -> Input) -> [Text] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (a -> ValueCodec a a -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a a
vc),
            files :: [FileData tag]
files = []
          }
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec value value
vc value
defaultValue Maybe Text
_ ->
        MultipartData
          { inputs :: [Input]
inputs =
              if a -> value
forall a b. Coercible a b => a -> b
coerce a
a value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
defaultValue
                then []
                else (Text -> Input) -> [Text] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Input
Input Text
key) (value -> ValueCodec value value -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue (a -> value
forall a b. Coercible a b => a -> b
coerce a
a) ValueCodec value value
vc),
            files :: [FileData tag]
files = []
          }
      PureCodec void
_ -> MultipartData tag
forall tag. MultipartData tag
memptyMultipartData
      ApCodec ObjectCodec a (output1 -> void)
oc1 ObjectCodec a output1
oc2 -> MultipartData tag -> MultipartData tag -> MultipartData tag
forall tag.
MultipartData tag -> MultipartData tag -> MultipartData tag
mappendMultipartData (a -> ObjectCodec a (output1 -> void) -> MultipartData tag
forall a void tag. a -> ObjectCodec a void -> MultipartData tag
go a
a ObjectCodec a (output1 -> void)
oc1) (a -> ObjectCodec a output1 -> MultipartData tag
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 -> oldInput -> Codec Value oldInput oldOutput -> [Text]
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 -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a of
        Left input1
a1 -> input1 -> Codec Value input1 output1 -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue input1
a1 Codec Value input1 output1
c1
        Right input2
a2 -> input2 -> Codec Value input2 output2 -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue input2
a2 Codec Value input2 output2
c2
      CommentCodec Text
_ ValueCodec a void
vc -> a -> ValueCodec a void -> [Text]
forall a void. a -> ValueCodec a void -> [Text]
goValue a
a ValueCodec a void
vc
      ArrayOfCodec Maybe Text
_ (ValueCodec input1 output1
vc :: ValueCodec input output) -> (input1 -> Text) -> [input1] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (input1 -> ValueCodec input1 output1 -> Text
forall a void. a -> ValueCodec a void -> Text
`goSingleValue` ValueCodec input1 output1
vc) (Vector input1 -> [input1]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (a -> Vector input1
forall a b. Coercible a b => a -> b
coerce a
a :: Vector input))
      ValueCodec a void
vc -> [a -> ValueCodec a void -> Text
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 -> oldInput -> Codec Value oldInput oldOutput -> Text
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 -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a of
        Left input1
a1 -> input1 -> Codec Value input1 output1 -> Text
forall a void. a -> ValueCodec a void -> Text
goSingleValue input1
a1 Codec Value input1 output1
c1
        Right input2
a2 -> input2 -> Codec Value input2 output2 -> Text
forall a void. a -> ValueCodec a void -> Text
goSingleValue input2
a2 Codec Value input2 output2
c2
      CommentCodec Text
_ ValueCodec a void
vc -> a -> ValueCodec a void -> Text
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 -> Bool
forall a b. Coercible a b => a -> b
coerce a
a of
          Bool
True -> Text
"True"
          Bool
False -> Text
"False"
      StringCodec Maybe Text
_ -> a -> Text
forall a b. Coercible a b => a -> b
coerce a
a
      ValueCodec a void
vc ->
        let value :: Value
value = ValueCodec a void -> a -> 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 (Value -> ByteString
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 = MultipartData tag -> [Input]
forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
mpd1 [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ MultipartData tag -> [Input]
forall tag. MultipartData tag -> [Input]
inputs MultipartData tag
mpd2,
      files :: [FileData tag]
files = MultipartData tag -> [FileData tag]
forall tag. MultipartData tag -> [FileData tag]
files MultipartData tag
mpd1 [FileData tag] -> [FileData tag] -> [FileData tag]
forall a. [a] -> [a] -> [a]
++ MultipartData tag -> [FileData tag]
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 = a -> MultipartData tag
forall a tag. HasObjectCodec a => a -> MultipartData tag
toMultipartViaCodec (a -> MultipartData tag)
-> (Autodocodec a -> a) -> Autodocodec a -> MultipartData tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Autodocodec a -> a
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 = ObjectCodec a a -> MultipartData tag -> Either String a
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 = (MultipartData tag -> ObjectCodec void a -> Either String a)
-> ObjectCodec void a -> MultipartData tag -> Either String a
forall a b c. (a -> b -> c) -> b -> a -> c
flip MultipartData tag -> ObjectCodec void a -> Either String a
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 -> MultipartData tag
-> Codec Object oldInput oldOutput -> Either String oldOutput
forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object oldInput oldOutput
c Either String oldOutput
-> (oldOutput -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
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 -> Either String (Either output1 output2) -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String (Either output1 output2) -> Either String a)
-> Either String (Either output1 output2) -> Either String a
forall a b. (a -> b) -> a -> b
$ case Union
u of
        Union
PossiblyJointUnion ->
          case MultipartData tag
-> Codec Object input1 output1 -> Either String output1
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 -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case MultipartData tag
-> Codec Object input2 output2 -> Either String output2
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 -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case (MultipartData tag
-> Codec Object input1 output1 -> Either String output1
forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd Codec Object input1 output1
c1, MultipartData tag
-> Codec Object input2 output2 -> Either String output2
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) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
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 <- Text -> MultipartData tag -> Either String Text
forall tag. Text -> MultipartData tag -> Either String Text
lookupInput Text
discriminator MultipartData tag
mpd
        case Text
-> HashMap Text (Text, ObjectCodec Void a)
-> Maybe (Text, ObjectCodec Void a)
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 -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected discriminator value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
discriminatorValue
          Just (Text
_, ObjectCodec Void a
c) -> MultipartData tag -> ObjectCodec Void a -> Either String a
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 <- Text -> MultipartData tag -> Either String [Text]
forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        [Text] -> ValueCodec void a -> Either String a
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 <- Text -> MultipartData tag -> Either String [Text]
forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        Either String (Maybe output1) -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String (Maybe output1) -> Either String a)
-> Either String (Maybe output1) -> Either String a
forall a b. (a -> b) -> a -> b
$ case [Text]
values of
          [] -> Maybe output1 -> Either String (Maybe output1)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe output1
forall a. Maybe a
Nothing
          [Text]
_ -> output1 -> Maybe output1
forall a. a -> Maybe a
Just (output1 -> Maybe output1)
-> Either String output1 -> Either String (Maybe output1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> ValueCodec input1 output1 -> Either String output1
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 <- Text -> MultipartData tag -> Either String [Text]
forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        Either String void -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String void -> Either String a)
-> Either String void -> Either String a
forall a b. (a -> b) -> a -> b
$ case [Text]
values of
          [] -> void -> Either String void
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure void
defaultValue
          [Text]
_ -> [Text] -> ValueCodec void void -> Either String void
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec void void
vc
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec value value
vc value
defaultValue Maybe Text
_ -> do
        [Text]
values <- Text -> MultipartData tag -> Either String [Text]
forall tag. Text -> MultipartData tag -> Either String [Text]
lookupLInput Text
key MultipartData tag
mpd
        Either String value -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String value -> Either String a)
-> Either String value -> Either String a
forall a b. (a -> b) -> a -> b
$ case [Text]
values of
          [] -> value -> Either String value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
defaultValue
          [Text]
_ -> [Text] -> ValueCodec value value -> Either String value
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
values ValueCodec value value
vc
      PureCodec a
v -> a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
      ApCodec ObjectCodec void (output1 -> a)
ocf ObjectCodec void output1
oca -> MultipartData tag
-> ObjectCodec void (output1 -> a) -> Either String (output1 -> a)
forall tag void a.
MultipartData tag -> ObjectCodec void a -> Either String a
go MultipartData tag
mpd ObjectCodec void (output1 -> a)
ocf Either String (output1 -> a)
-> Either String output1 -> Either String a
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MultipartData tag
-> ObjectCodec void output1 -> Either String output1
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 -> [Text] -> Codec Value oldInput oldOutput -> Either String oldOutput
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value oldInput oldOutput
c Either String oldOutput
-> (oldOutput -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
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 -> Either String (Either output1 output2) -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String (Either output1 output2) -> Either String a)
-> Either String (Either output1 output2) -> Either String a
forall a b. (a -> b) -> a -> b
$ case Union
u of
        Union
PossiblyJointUnion ->
          case [Text] -> Codec Value input1 output1 -> Either String output1
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input1 output1
c1 of
            Right output1
l -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case [Text] -> Codec Value input2 output2 -> Either String output2
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input2 output2
c2 of
              Left String
err2 -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case ([Text] -> Codec Value input1 output1 -> Either String output1
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input1 output1
c1, [Text] -> Codec Value input2 output2 -> Either String output2
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts Codec Value input2 output2
c2) of
            (Left String
_, Right output2
r) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
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 -> [Text] -> ValueCodec void a -> Either String a
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts ValueCodec void a
vc
      CommentCodec Text
_ ValueCodec void a
c -> [Text] -> ValueCodec void a -> Either String a
forall void a. [Text] -> ValueCodec void a -> Either String a
goValue [Text]
ts ValueCodec void a
c
      ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
vc -> Either String (Vector output1) -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String (Vector output1) -> Either String a)
-> Either String (Vector output1) -> Either String a
forall a b. (a -> b) -> a -> b
$ [output1] -> Vector output1
forall a. [a] -> Vector a
V.fromList ([output1] -> Vector output1)
-> Either String [output1] -> Either String (Vector output1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Either String output1)
-> [Text] -> Either String [output1]
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 (Text -> ValueCodec input1 output1 -> Either String output1
forall void a. Text -> ValueCodec void a -> Either String a
`goSingleValue` ValueCodec input1 output1
vc) ([Text] -> [Text]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Text]
ts)
      ValueCodec void a
vc -> case [Text]
ts of
        [Text
t] -> Text -> ValueCodec void a -> Either String a
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
vc
        [Text]
_ -> String -> Either String a
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 -> Text -> Codec Value oldInput oldOutput -> Either String oldOutput
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value oldInput oldOutput
c Either String oldOutput
-> (oldOutput -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
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 -> Either String (Either output1 output2) -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String (Either output1 output2) -> Either String a)
-> Either String (Either output1 output2) -> Either String a
forall a b. (a -> b) -> a -> b
$ case Union
u of
        Union
PossiblyJointUnion ->
          case Text -> Codec Value input1 output1 -> Either String output1
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input1 output1
c1 of
            Right output1
l -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            Left String
err1 -> case Text -> Codec Value input2 output2 -> Either String output2
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input2 output2
c2 of
              Left String
err2 -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
forall a b. (a -> b) -> a -> b
$ String
"  Previous branch failure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err2
              Right output2
r -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
        Union
DisjointUnion ->
          case (Text -> Codec Value input1 output1 -> Either String output1
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input1 output1
c1, Text -> Codec Value input2 output2 -> Either String output2
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t Codec Value input2 output2
c2) of
            (Left String
_, Right output2
r) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output2 -> Either output1 output2
forall a b. b -> Either a b
Right output2
r)
            (Right output1
l, Left String
_) -> Either output1 output2 -> Either String (Either output1 output2)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (output1 -> Either output1 output2
forall a b. a -> Either a b
Left output1
l)
            (Right output1
_, Right output2
_) -> String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left String
"Both branches of a disjoint union succeeded."
            (Left String
lErr, Left String
rErr) ->
              String -> Either String (Either output1 output2)
forall a b. a -> Either a b
Left (String -> Either String (Either output1 output2))
-> String -> Either String (Either output1 output2)
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 -> Text -> ValueCodec void a -> Either String a
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
c
      ReferenceCodec Text
_ ValueCodec void a
vc -> Text -> ValueCodec void a -> Either String a
forall void a. Text -> ValueCodec void a -> Either String a
goSingleValue Text
t ValueCodec void a
vc
      ValueCodec void a
NullCodec -> Either String () -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String () -> Either String a)
-> Either String () -> Either String a
forall a b. (a -> b) -> a -> b
$ case Text
t of
        Text
"null" -> () -> Either String ()
forall a b. b -> Either a b
Right ()
        Text
_ -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"not 'null': " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
      BoolCodec Maybe Text
_ -> Either String Bool -> Either String a
forall a b. Coercible a b => a -> b
coerce (Either String Bool -> Either String a)
-> Either String Bool -> Either String a
forall a b. (a -> b) -> a -> b
$ case Text
t of
        Text
"false" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
        Text
"False" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
        Text
"true" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
        Text
"True" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
        Text
_ -> String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool) -> String -> Either String Bool
forall a b. (a -> b) -> a -> b
$ String
"Unknown bool: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
      StringCodec Maybe Text
_ -> a -> Either String a
forall a b. b -> Either a b
Right (Text -> a
forall a b. Coercible a b => a -> b
coerce Text
t)
      ValueCodec void a
vc -> case (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither (ValueCodec void a -> Value -> Parser a
forall void a. ValueCodec void a -> Value -> Parser a
parseJSONVia ValueCodec void a
vc) (Text -> Value
JSON.String Text
t) of
        Right a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
        Left String
_ -> do
          Value
value <- ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode (ByteString -> ByteString
LB.fromStrict (Text -> ByteString
TE.encodeUtf8 Text
t))
          (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither (ValueCodec void a -> Value -> Parser a
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 = Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right (Maybe Text -> Either String (Maybe Text))
-> (MultipartData tag -> Maybe Text)
-> MultipartData tag
-> Either String (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Text) -> Maybe Input -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Input -> Text
iValue (Maybe Input -> Maybe Text)
-> (MultipartData tag -> Maybe Input)
-> MultipartData tag
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Bool) -> [Input] -> Maybe Input
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
iname) (Text -> Bool) -> (Input -> Text) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Text
iName) ([Input] -> Maybe Input)
-> (MultipartData tag -> [Input])
-> MultipartData tag
-> Maybe Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipartData tag -> [Input]
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 = [Text] -> Either String [Text]
forall a b. b -> Either a b
Right ([Text] -> Either String [Text])
-> (MultipartData tag -> [Text])
-> MultipartData tag
-> Either String [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Text) -> [Input] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Text
iValue ([Input] -> [Text])
-> (MultipartData tag -> [Input]) -> MultipartData tag -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
iname) (Text -> Bool) -> (Input -> Text) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Text
iName) ([Input] -> [Input])
-> (MultipartData tag -> [Input]) -> MultipartData tag -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultipartData tag -> [Input]
forall tag. MultipartData tag -> [Input]
inputs

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