module Web.Minion.Examples.ComplexResponse (app) where

import Data.Unique (hashUnique, newUnique)
import Web.Minion
import Web.Minion.Json (Json)
import Web.Minion.Response.Header
import Web.Minion.Response.Status
import Web.Minion.Response.Union

app :: ApplicationM IO
app :: ApplicationM IO
app = Router' Void Void IO -> ApplicationM IO
forall (m :: * -> *) i.
(MonadIO m, MonadCatch m) =>
Router' i Void m -> ApplicationM m
serve Router' Void Void IO
api

api :: Router Void IO
api :: Router' Void Void IO
api = Router' Void Void IO -> Router' Void Void IO
"api" (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Void Void IO -> Router' Void Void IO
"complex" (Router' Void Void IO -> Router' Void Void IO)
-> Router' Void Void IO -> Router' Void Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Method
-> (DelayedArgs '[]
    ~> IO
         (Union
            '[RespBody '[Json] Int,
              WithStatus
                SeeOther
                (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)]))
-> Router' Void Void IO
forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
Method -> (DelayedArgs st ~> m o) -> Router' i ts m
handle Method
GET IO
  (Union
     '[RespBody '[Json] Int,
       WithStatus
         SeeOther
         (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)])
DelayedArgs '[]
~> IO
     (Union
        '[RespBody '[Json] Int,
          WithStatus
            SeeOther
            (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)])
endpoint

endpoint ::
  IO
    ( Union
        [ RespBody '[Json] Int
        , WithStatus SeeOther (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)
        ]
    )
endpoint :: IO
  (Union
     '[RespBody '[Json] Int,
       WithStatus
         SeeOther
         (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)])
endpoint = do
  Bool
a <- (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Unique -> Int) -> Unique -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) (Int -> Int) -> (Unique -> Int) -> Unique -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique -> Int
hashUnique (Unique -> Bool) -> IO Unique -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique
  let respJson :: RespBody '[Json] Int
respJson = forall (cts :: [*]) a. a -> RespBody cts a
forall {k} (cts :: k) a. a -> RespBody cts a
RespBody @'[Json] @Int Int
1
      redirectHeader :: AddHeader "Location" RawHeaderValue
redirectHeader = forall {k} (name :: k) a. a -> AddHeader name a
forall (name :: Symbol) a. a -> AddHeader name a
AddHeader @"Location" (Method -> RawHeaderValue
RawHeaderValue Method
"https://google.com")
      respSeeOther :: WithStatus
  SeeOther (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)
respSeeOther = forall {k} (status :: k) a. a -> WithStatus status a
forall status a. a -> WithStatus status a
WithStatus @SeeOther (HList '[AddHeader "Location" RawHeaderValue]
-> NoBody
-> AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody
forall (hs :: [*]) a. HList hs -> a -> AddHeaders hs a
AddHeaders (AddHeader "Location" RawHeaderValue
redirectHeader AddHeader "Location" RawHeaderValue
-> HList '[] -> HList '[AddHeader "Location" RawHeaderValue]
forall t (ts1 :: [*]). t -> HList ts1 -> HList (t : ts1)
:# HList '[]
HNil) NoBody
NoBody)
  Union
  '[RespBody '[Json] Int,
    WithStatus
      SeeOther
      (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)]
-> IO
     (Union
        '[RespBody '[Json] Int,
          WithStatus
            SeeOther
            (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure if Bool
a then RespBody '[Json] Int
-> Union
     '[RespBody '[Json] Int,
       WithStatus
         SeeOther
         (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)]
forall a (as :: [*]). Inject a as => a -> Union as
inject RespBody '[Json] Int
respJson else WithStatus
  SeeOther (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)
-> Union
     '[RespBody '[Json] Int,
       WithStatus
         SeeOther
         (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)]
forall a (as :: [*]). Inject a as => a -> Union as
inject WithStatus
  SeeOther (AddHeaders '[AddHeader "Location" RawHeaderValue] NoBody)
respSeeOther