module Okapi.HTTP.Response.Status (
    KnownStatus (..),
    Status (..),
    ParseError (..),
    parse,
    print,
    raw,
    status,
    knownStatusToHTTP,
    extractStatus,
    S200,
    S201,
    S204,
    S404,
    S500,
) where

import Data.Kind (Type)
import GHC.TypeLits (Nat)
import Network.HTTP.Types qualified as HTTP
import Okapi.Tree (Failure, Context)
import Prelude hiding (print)

data KnownStatus (s :: Nat) where
    S200 :: KnownStatus 200
    S201 :: KnownStatus 201
    S204 :: KnownStatus 204
    S404 :: KnownStatus 404
    S500 :: KnownStatus 500

deriving instance Eq   (KnownStatus s)
deriving instance Show (KnownStatus s)

type S200 = KnownStatus 200
type S201 = KnownStatus 201
type S204 = KnownStatus 204
type S404 = KnownStatus 404
type S500 = KnownStatus 500

instance Num (KnownStatus 200) where
    fromInteger :: Integer -> KnownStatus 200
fromInteger Integer
200 = KnownStatus 200
S200
    fromInteger Integer
_ = String -> KnownStatus 200
forall a. HasCallStack => String -> a
error String
"KnownStatus 200: expected 200"
    KnownStatus 200
S200 + :: KnownStatus 200 -> KnownStatus 200 -> KnownStatus 200
+ KnownStatus 200
S200 = KnownStatus 200
S200
    KnownStatus 200
S200 * :: KnownStatus 200 -> KnownStatus 200 -> KnownStatus 200
* KnownStatus 200
S200 = KnownStatus 200
S200
    abs :: KnownStatus 200 -> KnownStatus 200
abs = KnownStatus 200 -> KnownStatus 200
forall a. a -> a
id; signum :: KnownStatus 200 -> KnownStatus 200
signum KnownStatus 200
_ = KnownStatus 200
S200; negate :: KnownStatus 200 -> KnownStatus 200
negate = KnownStatus 200 -> KnownStatus 200
forall a. a -> a
id

instance Num (KnownStatus 201) where
    fromInteger :: Integer -> KnownStatus 201
fromInteger Integer
201 = KnownStatus 201
S201
    fromInteger Integer
_ = String -> KnownStatus 201
forall a. HasCallStack => String -> a
error String
"KnownStatus 201: expected 201"
    KnownStatus 201
S201 + :: KnownStatus 201 -> KnownStatus 201 -> KnownStatus 201
+ KnownStatus 201
S201 = KnownStatus 201
S201
    KnownStatus 201
S201 * :: KnownStatus 201 -> KnownStatus 201 -> KnownStatus 201
* KnownStatus 201
S201 = KnownStatus 201
S201
    abs :: KnownStatus 201 -> KnownStatus 201
abs = KnownStatus 201 -> KnownStatus 201
forall a. a -> a
id; signum :: KnownStatus 201 -> KnownStatus 201
signum KnownStatus 201
_ = KnownStatus 201
S201; negate :: KnownStatus 201 -> KnownStatus 201
negate = KnownStatus 201 -> KnownStatus 201
forall a. a -> a
id

instance Num (KnownStatus 204) where
    fromInteger :: Integer -> KnownStatus 204
fromInteger Integer
204 = KnownStatus 204
S204
    fromInteger Integer
_ = String -> KnownStatus 204
forall a. HasCallStack => String -> a
error String
"KnownStatus 204: expected 204"
    KnownStatus 204
S204 + :: KnownStatus 204 -> KnownStatus 204 -> KnownStatus 204
+ KnownStatus 204
S204 = KnownStatus 204
S204
    KnownStatus 204
S204 * :: KnownStatus 204 -> KnownStatus 204 -> KnownStatus 204
* KnownStatus 204
S204 = KnownStatus 204
S204
    abs :: KnownStatus 204 -> KnownStatus 204
abs = KnownStatus 204 -> KnownStatus 204
forall a. a -> a
id; signum :: KnownStatus 204 -> KnownStatus 204
signum KnownStatus 204
_ = KnownStatus 204
S204; negate :: KnownStatus 204 -> KnownStatus 204
negate = KnownStatus 204 -> KnownStatus 204
forall a. a -> a
id

instance Num (KnownStatus 404) where
    fromInteger :: Integer -> KnownStatus 404
fromInteger Integer
404 = KnownStatus 404
S404
    fromInteger Integer
_ = String -> KnownStatus 404
forall a. HasCallStack => String -> a
error String
"KnownStatus 404: expected 404"
    KnownStatus 404
S404 + :: KnownStatus 404 -> KnownStatus 404 -> KnownStatus 404
+ KnownStatus 404
S404 = KnownStatus 404
S404
    KnownStatus 404
S404 * :: KnownStatus 404 -> KnownStatus 404 -> KnownStatus 404
* KnownStatus 404
S404 = KnownStatus 404
S404
    abs :: KnownStatus 404 -> KnownStatus 404
abs = KnownStatus 404 -> KnownStatus 404
forall a. a -> a
id; signum :: KnownStatus 404 -> KnownStatus 404
signum KnownStatus 404
_ = KnownStatus 404
S404; negate :: KnownStatus 404 -> KnownStatus 404
negate = KnownStatus 404 -> KnownStatus 404
forall a. a -> a
id

instance Num (KnownStatus 500) where
    fromInteger :: Integer -> KnownStatus 500
fromInteger Integer
500 = KnownStatus 500
S500
    fromInteger Integer
_ = String -> KnownStatus 500
forall a. HasCallStack => String -> a
error String
"KnownStatus 500: expected 500"
    KnownStatus 500
S500 + :: KnownStatus 500 -> KnownStatus 500 -> KnownStatus 500
+ KnownStatus 500
S500 = KnownStatus 500
S500
    KnownStatus 500
S500 * :: KnownStatus 500 -> KnownStatus 500 -> KnownStatus 500
* KnownStatus 500
S500 = KnownStatus 500
S500
    abs :: KnownStatus 500 -> KnownStatus 500
abs = KnownStatus 500 -> KnownStatus 500
forall a. a -> a
id; signum :: KnownStatus 500 -> KnownStatus 500
signum KnownStatus 500
_ = KnownStatus 500
S500; negate :: KnownStatus 500 -> KnownStatus 500
negate = KnownStatus 500 -> KnownStatus 500
forall a. a -> a
id

type Status :: Type -> Type
data Status a where
    Raw    :: Status HTTP.Status
    Status :: KnownStatus s -> Status (KnownStatus s)

data ParseError = ParseError deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

type instance Context Status = HTTP.Status
type instance Failure Status = ParseError

parse :: Status status -> HTTP.Status -> Either ParseError status
parse :: forall status. Status status -> Status -> Either ParseError status
parse Status status
Raw         Status
s = status -> Either ParseError status
forall a b. b -> Either a b
Right status
Status
s
parse (Status KnownStatus s
ks) Status
s
    | Status
s Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== KnownStatus s -> Status
forall (s :: Nat). KnownStatus s -> Status
knownStatusToHTTP KnownStatus s
ks = status -> Either ParseError status
forall a b. b -> Either a b
Right status
KnownStatus s
ks
    | Bool
otherwise                 = ParseError -> Either ParseError status
forall a b. a -> Either a b
Left ParseError
ParseError

print :: Status status -> status -> HTTP.Status
print :: forall status. Status status -> status -> Status
print Status status
Raw         status
s  = status
Status
s
print (Status KnownStatus s
ks) status
_  = KnownStatus s -> Status
forall (s :: Nat). KnownStatus s -> Status
knownStatusToHTTP KnownStatus s
ks

raw :: Status HTTP.Status
raw :: Status Status
raw = Status Status
Raw

status :: KnownStatus s -> Status (KnownStatus s)
status :: forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
status = KnownStatus s -> Status (KnownStatus s)
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status

knownStatusToHTTP :: KnownStatus s -> HTTP.Status
knownStatusToHTTP :: forall (s :: Nat). KnownStatus s -> Status
knownStatusToHTTP KnownStatus s
S200 = Status
HTTP.status200
knownStatusToHTTP KnownStatus s
S201 = Status
HTTP.status201
knownStatusToHTTP KnownStatus s
S204 = Status
HTTP.status204
knownStatusToHTTP KnownStatus s
S404 = Status
HTTP.status404
knownStatusToHTTP KnownStatus s
S500 = Status
HTTP.status500

extractStatus :: Status (KnownStatus s) -> HTTP.Status
extractStatus :: forall (s :: Nat). Status (KnownStatus s) -> Status
extractStatus (Status KnownStatus s
ks) = KnownStatus s -> Status
forall (s :: Nat). KnownStatus s -> Status
knownStatusToHTTP KnownStatus s
ks