waiz-0.0.1.0: src/Network/Wai/Optics/RequestBodyLength.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

-- | Classy optics and constructor prisms for 'RequestBodyLength'.
module Network.Wai.Optics.RequestBodyLength (
  -- * Classy optics
  GetRequestBodyLength (..),
  HasRequestBodyLength (..),
  ReviewRequestBodyLength (..),
  AsRequestBodyLength (..),

  -- * Constructor prisms

  -- ** ChunkedBody
  ReviewChunkedBody (..),
  AsChunkedBody (..),

  -- ** KnownLength
  ReviewKnownLength (..),
  AsKnownLength (..),
) where

import Control.Category (id)
import Control.Lens (Getter, Lens', Prism', Review, lens, prism', review, unto, view)
import Data.Maybe (Maybe (..))
import Data.Word (Word64)
import Network.Wai.Internal (RequestBodyLength (..))
import Prelude (const, flip)

{- $setup
>>> import Control.Lens (view, set, preview)
>>> import Network.Wai.Internal (RequestBodyLength(ChunkedBody, KnownLength))
-}

{- | Type class for values that can be viewed as a 'RequestBodyLength'.

>>> view getRequestBodyLength ChunkedBody
ChunkedBody

>>> view getRequestBodyLength (KnownLength 1024)
KnownLength 1024
-}
class GetRequestBodyLength s where
  -- | A 'Getter' to obtain a 'RequestBodyLength'.
  getRequestBodyLength :: Getter s RequestBodyLength

instance GetRequestBodyLength RequestBodyLength where
  getRequestBodyLength = id
  {-# INLINE getRequestBodyLength #-}

{- | Type class for values with a lens into a 'RequestBodyLength'.

>>> set requestBodyLengthL (KnownLength 512) ChunkedBody
KnownLength 512
-}
class (GetRequestBodyLength s) => HasRequestBodyLength s where
  {-# MINIMAL setRequestBodyLength #-}

  -- | Replace the 'RequestBodyLength' component.
  setRequestBodyLength :: RequestBodyLength -> s -> s

  -- | A 'Lens'' into the 'RequestBodyLength' component.
  requestBodyLengthL :: Lens' s RequestBodyLength
  requestBodyLengthL = lens (view getRequestBodyLength) (flip setRequestBodyLength)
  {-# INLINE requestBodyLengthL #-}

instance HasRequestBodyLength RequestBodyLength where
  setRequestBodyLength = const
  {-# INLINE setRequestBodyLength #-}

{- | Type class for values that can be constructed from a 'RequestBodyLength'.

>>> review reviewRequestBodyLength ChunkedBody :: RequestBodyLength
ChunkedBody
-}
class ReviewRequestBodyLength t where
  -- | A 'Review' to construct a value from a 'RequestBodyLength'.
  reviewRequestBodyLength :: Review t RequestBodyLength

instance ReviewRequestBodyLength RequestBodyLength where
  reviewRequestBodyLength = unto id
  {-# INLINE reviewRequestBodyLength #-}

{- | Type class for values with a prism into a 'RequestBodyLength'.

>>> preview _RequestBodyLength (KnownLength 1024)
Just (KnownLength 1024)
-}
class (ReviewRequestBodyLength t) => AsRequestBodyLength t where
  {-# MINIMAL matchRequestBodyLength #-}

  -- | Attempt to extract a 'RequestBodyLength'.
  matchRequestBodyLength :: t -> Maybe RequestBodyLength

  -- | A 'Prism'' into a 'RequestBodyLength'.
  _RequestBodyLength :: Prism' t RequestBodyLength
  _RequestBodyLength = prism' (review reviewRequestBodyLength) matchRequestBodyLength
  {-# INLINE _RequestBodyLength #-}

instance AsRequestBodyLength RequestBodyLength where
  matchRequestBodyLength = Just
  {-# INLINE matchRequestBodyLength #-}

-- ** ChunkedBody

{- | Type class for values that can be constructed as a 'ChunkedBody'.

>>> review reviewChunkedBody () :: RequestBodyLength
ChunkedBody
-}
class ReviewChunkedBody t where
  -- | A 'Review' to construct a 'ChunkedBody'.
  reviewChunkedBody :: Review t ()

instance ReviewChunkedBody RequestBodyLength where
  reviewChunkedBody = unto (\() -> ChunkedBody)
  {-# INLINE reviewChunkedBody #-}

{- | Type class for values with a prism into a 'ChunkedBody'.

>>> preview _ChunkedBody ChunkedBody
Just ()

>>> preview _ChunkedBody (KnownLength 1024)
Nothing
-}
class (ReviewChunkedBody t) => AsChunkedBody t where
  {-# MINIMAL matchChunkedBody #-}

  -- | Attempt to match a 'ChunkedBody'.
  matchChunkedBody :: t -> Maybe ()

  -- | A 'Prism'' into a 'ChunkedBody'.
  _ChunkedBody :: Prism' t ()
  _ChunkedBody = prism' (review reviewChunkedBody) matchChunkedBody
  {-# INLINE _ChunkedBody #-}

instance AsChunkedBody RequestBodyLength where
  matchChunkedBody = \case
    ChunkedBody -> Just ()
    _ -> Nothing
  {-# INLINE matchChunkedBody #-}

-- ** KnownLength

{- | Type class for values that can be constructed as a 'KnownLength'.

>>> review reviewKnownLength 1024 :: RequestBodyLength
KnownLength 1024
-}
class ReviewKnownLength t where
  -- | A 'Review' to construct a 'KnownLength'.
  reviewKnownLength :: Review t Word64

instance ReviewKnownLength RequestBodyLength where
  reviewKnownLength = unto KnownLength
  {-# INLINE reviewKnownLength #-}

{- | Type class for values with a prism into a 'KnownLength'.

>>> preview _KnownLength (KnownLength 1024)
Just 1024

>>> preview _KnownLength ChunkedBody
Nothing
-}
class (ReviewKnownLength t) => AsKnownLength t where
  {-# MINIMAL matchKnownLength #-}

  -- | Attempt to extract the length from a 'KnownLength'.
  matchKnownLength :: t -> Maybe Word64

  -- | A 'Prism'' into a 'KnownLength'.
  _KnownLength :: Prism' t Word64
  _KnownLength = prism' (review reviewKnownLength) matchKnownLength
  {-# INLINE _KnownLength #-}

instance AsKnownLength RequestBodyLength where
  matchKnownLength = \case
    KnownLength n -> Just n
    _ -> Nothing
  {-# INLINE matchKnownLength #-}