<commit_before>{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Module defining a set of types corresponding to HTTP status codes
-- along with their singleton values. Only the most common codes are
-- supported by name, although fully custom codes are generally supported.
module Serv.Internal.StatusCode where

import Data.Singletons
import Data.Singletons.TH
import GHC.TypeLits

singletons
  [d|
    data StatusCode code

      ---- Custom codes

      = CustomStatus code
        -- ^ Inject an arbitatry code number as a status code.

      ---- 1xx Informational

      | Continue
      | SwitchingProtocols

      ---- 2xx Success

      | Ok
      | Created
      | Accepted
      | NonAuthoritiveInformation
      | NoContent
      | ResetContent
      | PartialContent
      | IMUsed

      ---- 3xx Redirection

      | MultipleChoices
      | MovedPermanently
      | Found
      | SeeOther
      | NotModified
      | TemporaryRedirect
      | PermanentRedirect

      ---- 4xx Client Error

      | BadRequest
      | Unauthorized
      | PaymentRequired
      | Forbidden
      | NotFound
      | MethodNotAllowed
      | NotAcceptable
      | ProxyAuthenticationRequired
      | RequestTimeout
      | Conflict
      | Gone
      | LengthRequired
      | PreconditionFailed
      | PayloadTooLarge
      | RequestURITooLong
      | UnsupportedMediaType
      | RequestedRangeNotSatisfiable
      | ExpectationFailed
      | MisdirectedRequest
      | UnprocessableEntity
      | Locked
      | FailedDependency
      | UpgradeRequired
      | PreconditionRequired
      | TooManyRequests
      | RequestHeaderFieldsTooLarge
      | UnavailableForLegalReasons

      ---- 5xx Server Error

      | InternalServerError
      | NotImplemented
      | BadGateway
      | ServiceUnavailable
      | GatewayTimeout
      | HTTPVersionNotSupported
      | VariantAlsoNegotiates
      | InsufficientStorage
      | LoopDetected
      | NotExtended
      | NetworkAuthenticationRequired

  |]

deriving instance Show a => Show (StatusCode a)
deriving instance Read a => Read (StatusCode a)
deriving instance Eq a => Eq (StatusCode a)
deriving instance Ord a => Ord (StatusCode a)
deriving instance Functor StatusCode

type CustomStatus code = 'CustomStatus code
type Continue = 'Continue
type SwitchingProtocols = 'SwitchingProtocols
type Ok = 'Ok
type Created = 'Created
type Accepted = 'Accepted
type NonAuthoritiveInformation = 'NonAuthoritiveInformation
type NoContent = 'NoContent
type ResetContent = 'ResetContent
type PartialContent = 'PartialContent
type IMUsed = 'IMUsed
type MovedPermanently = 'MovedPermanently
type Found = 'Found
type SeeOther = 'SeeOther
type NotModified = 'NotModified
type TemporaryRedirect = 'TemporaryRedirect
type PermanentRedirect = 'PermanentRedirect
type Unauthorized = 'Unauthorized
type PaymentRequired = 'PaymentRequired
type Forbidden = 'Forbidden
type NotFound = 'NotFound
type MethodNotAllowed = 'MethodNotAllowed
type NotAcceptable = 'NotAcceptable
type ProxyAuthenticationRequired = 'ProxyAuthenticationRequired
type RequestTimeout = 'RequestTimeout
type Conflict = 'Conflict
type Gone = 'Gone
type LengthRequired = 'LengthRequired
type PreconditionFailed = 'PreconditionFailed
type PayloadTooLarge = 'PayloadTooLarge
type RequestURITooLong = 'RequestURITooLong
type UnsupportedMediaType = 'UnsupportedMediaType
type RequestedRangeNotSatisfiable = 'RequestedRangeNotSatisfiable
type ExpectationFailed = 'ExpectationFailed
type MisdirectedRequest = 'MisdirectedRequest
type UnprocessableEntity = 'UnprocessableEntity
type Locked = 'Locked
type FailedDependency = 'FailedDependency
type UpgradeRequired = 'UpgradeRequired
type PreconditionRequired = 'PreconditionRequired
type TooManyRequests = 'TooManyRequests
type RequestHeaderFieldsTooLarge = 'RequestHeaderFieldsTooLarge
type UnavailableForLegalReasons = 'UnavailableForLegalReasons
type NotImplemented = 'NotImplemented
type BadGateway = 'BadGateway
type ServiceUnavailable = 'ServiceUnavailable
type GatewayTimeout = 'GatewayTimeout
type HTTPVersionNotSupported = 'HTTPVersionNotSupported
type VariantAlsoNegotiates = 'VariantAlsoNegotiates
type InsufficientStorage = 'InsufficientStorage
type LoopDetected = 'LoopDetected
type NotExtended = 'NotExtended
type NetworkAuthenticationRequired = 'NetworkAuthenticationRequired

statusCode :: forall (c :: StatusCode Nat) . Sing c -> StatusCode Integer
statusCode = fromSing

code :: StatusCode Integer -> Integer
code c =
  case c of
    CustomStatus code -> code

    Continue -> 100
    SwitchingProtocols -> 101

    Ok -> 200
    Created -> 201
    Accepted -> 202
    NonAuthoritiveInformation -> 203
    NoContent -> 204
    ResetContent -> 205
    PartialContent -> 206
    IMUsed -> 226

    MultipleChoices -> 300<commit_msg>pacify PEDANTIC mode<commit_after>{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Module defining a set of types corresponding to HTTP status codes
-- along with their singleton values. Only the most common codes are
-- supported by name, although fully custom codes are generally supported.
module Serv.Internal.StatusCode where

import Data.Singletons
import Data.Singletons.TH
import GHC.TypeLits

singletons
  [d|
    data StatusCode code

      ---- Custom codes

      = CustomStatus code
        -- ^ Inject an arbitatry code number as a status code.

      ---- 1xx Informational

      | Continue
      | SwitchingProtocols

      ---- 2xx Success

      | Ok
      | Created
      | Accepted
      | NonAuthoritiveInformation
      | NoContent
      | ResetContent
      | PartialContent
      | IMUsed

      ---- 3xx Redirection

      | MultipleChoices
      | MovedPermanently
      | Found
      | SeeOther
      | NotModified
      | TemporaryRedirect
      | PermanentRedirect

      ---- 4xx Client Error

      | BadRequest
      | Unauthorized
      | PaymentRequired
      | Forbidden
      | NotFound
      | MethodNotAllowed
      | NotAcceptable
      | ProxyAuthenticationRequired
      | RequestTimeout
      | Conflict
      | Gone
      | LengthRequired
      | PreconditionFailed
      | PayloadTooLarge
      | RequestURITooLong
      | UnsupportedMediaType
      | RequestedRangeNotSatisfiable
      | ExpectationFailed
      | MisdirectedRequest
      | UnprocessableEntity
      | Locked
      | FailedDependency
      | UpgradeRequired
      | PreconditionRequired
      | TooManyRequests
      | RequestHeaderFieldsTooLarge
      | UnavailableForLegalReasons

      ---- 5xx Server Error

      | InternalServerError
      | NotImplemented
      | BadGateway
      | ServiceUnavailable
      | GatewayTimeout
      | HTTPVersionNotSupported
      | VariantAlsoNegotiates
      | InsufficientStorage
      | LoopDetected
      | NotExtended
      | NetworkAuthenticationRequired

  |]

deriving instance Show a => Show (StatusCode a)
deriving instance Read a => Read (StatusCode a)
deriving instance Eq a => Eq (StatusCode a)
deriving instance Ord a => Ord (StatusCode a)
deriving instance Functor StatusCode

type CustomStatus code = 'CustomStatus code
type Continue = 'Continue
type SwitchingProtocols = 'SwitchingProtocols
type Ok = 'Ok
type Created = 'Created
type Accepted = 'Accepted
type NonAuthoritiveInformation = 'NonAuthoritiveInformation
type NoContent = 'NoContent
type ResetContent = 'ResetContent
type PartialContent = 'PartialContent
type IMUsed = 'IMUsed
type MovedPermanently = 'MovedPermanently
type Found = 'Found
type SeeOther = 'SeeOther
type NotModified = 'NotModified
type TemporaryRedirect = 'TemporaryRedirect
type PermanentRedirect = 'PermanentRedirect
type Unauthorized = 'Unauthorized
type PaymentRequired = 'PaymentRequired
type Forbidden = 'Forbidden
type NotFound = 'NotFound
type MethodNotAllowed = 'MethodNotAllowed
type NotAcceptable = 'NotAcceptable
type ProxyAuthenticationRequired = 'ProxyAuthenticationRequired
type RequestTimeout = 'RequestTimeout
type Conflict = 'Conflict
type Gone = 'Gone
type LengthRequired = 'LengthRequired
type PreconditionFailed = 'PreconditionFailed
type PayloadTooLarge = 'PayloadTooLarge
type RequestURITooLong = 'RequestURITooLong
type UnsupportedMediaType = 'UnsupportedMediaType
type RequestedRangeNotSatisfiable = 'RequestedRangeNotSatisfiable
type ExpectationFailed = 'ExpectationFailed
type MisdirectedRequest = 'MisdirectedRequest
type UnprocessableEntity = 'UnprocessableEntity
type Locked = 'Locked
type FailedDependency = 'FailedDependency
type UpgradeRequired = 'UpgradeRequired
type PreconditionRequired = 'PreconditionRequired
type TooManyRequests = 'TooManyRequests
type RequestHeaderFieldsTooLarge = 'RequestHeaderFieldsTooLarge
type UnavailableForLegalReasons = 'UnavailableForLegalReasons
type NotImplemented = 'NotImplemented
type BadGateway = 'BadGateway
type ServiceUnavailable = 'ServiceUnavailable
type GatewayTimeout = 'GatewayTimeout
type HTTPVersionNotSupported = 'HTTPVersionNotSupported
type VariantAlsoNegotiates = 'VariantAlsoNegotiates
type InsufficientStorage = 'InsufficientStorage
type LoopDetected = 'LoopDetected
type NotExtended = 'NotExtended
type NetworkAuthenticationRequired = 'NetworkAuthenticationRequired

statusCode :: forall (c :: StatusCode Nat) . Sing c -> StatusCode Integer
statusCode = fromSing

code :: StatusCode Integer -> Integer
code c =
  case c of
    CustomStatus int -> int

    Continue -> 100
    SwitchingProtocols -> 101

    Ok -> 200
    Created -> 201
    Accepted -> 202
    NonAuthoritiveInformation -> 203
    NoContent -> 204
    ResetContent -> 205
    PartialContent -> 206
    IMUsed -> 226

    MultipleChoices -> 300
{'fraction_non_alphanumeric': 0.06464724668537694, 'fraction_numerical': 0.007355075970192587, 'mean_word_length': 3.4409110442629998, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 39, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5877160', 'n_tokens_mistral': 2882, 'n_tokens_neox': 2724, 'n_words': 775}