{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Servant.API.Range (Range (unRange), unsafeRange, mkRange) where

import           Data.Aeson
import           Data.Aeson.Types (modifyFailure)
import           Data.Bifunctor   (first)
import           Data.Ix
import           Data.Proxy       (Proxy (Proxy))
import qualified Data.Text        as T
import           GHC.Generics     (Generic)
import           GHC.TypeLits
import           Servant.API

-- | A newtype wrapper around 'Natural' that ensures the value is within a given range.
--
-- Example:
--
-- >>> :{
--   let validRange = mkRange 5 :: Maybe (Range 1 10)
--   in case validRange of
--        Just r  -> "Valid range: " ++ show (unRange r)
--        Nothing -> "Invalid range"
-- :}
-- "Valid range: 5"
--
-- >>> :{
--   let invalidRange = mkRange 15 :: Maybe (Range 1 10)
--   in case invalidRange of
--        Just r  -> "Valid range: " ++ show (unRange r)
--        Nothing -> "Invalid range"
-- :}
-- "Invalid range"
--
-- >>> decode "5" :: Maybe (Range 1 10)
-- Just (MkRange {unRange = 5})
--
-- >>> decode "15" :: Maybe (Range 1 10)
-- Nothing
newtype Range (min :: Nat) (max :: Nat) = MkRange {forall (min :: Nat) (max :: Nat). Range min max -> Nat
unRange :: Natural}
    deriving stock (Range min max -> Range min max -> Bool
(Range min max -> Range min max -> Bool)
-> (Range min max -> Range min max -> Bool) -> Eq (Range min max)
forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
== :: Range min max -> Range min max -> Bool
$c/= :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
/= :: Range min max -> Range min max -> Bool
Eq, Eq (Range min max)
Eq (Range min max) =>
(Range min max -> Range min max -> Ordering)
-> (Range min max -> Range min max -> Bool)
-> (Range min max -> Range min max -> Bool)
-> (Range min max -> Range min max -> Bool)
-> (Range min max -> Range min max -> Bool)
-> (Range min max -> Range min max -> Range min max)
-> (Range min max -> Range min max -> Range min max)
-> Ord (Range min max)
Range min max -> Range min max -> Bool
Range min max -> Range min max -> Ordering
Range min max -> Range min max -> Range min max
forall (min :: Nat) (max :: Nat). Eq (Range min max)
forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Ordering
forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Range min max
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Ordering
compare :: Range min max -> Range min max -> Ordering
$c< :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
< :: Range min max -> Range min max -> Bool
$c<= :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
<= :: Range min max -> Range min max -> Bool
$c> :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
> :: Range min max -> Range min max -> Bool
$c>= :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Bool
>= :: Range min max -> Range min max -> Bool
$cmax :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Range min max
max :: Range min max -> Range min max -> Range min max
$cmin :: forall (min :: Nat) (max :: Nat).
Range min max -> Range min max -> Range min max
min :: Range min max -> Range min max -> Range min max
Ord, Int -> Range min max -> ShowS
[Range min max] -> ShowS
Range min max -> String
(Int -> Range min max -> ShowS)
-> (Range min max -> String)
-> ([Range min max] -> ShowS)
-> Show (Range min max)
forall (min :: Nat) (max :: Nat). Int -> Range min max -> ShowS
forall (min :: Nat) (max :: Nat). [Range min max] -> ShowS
forall (min :: Nat) (max :: Nat). Range min max -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (min :: Nat) (max :: Nat). Int -> Range min max -> ShowS
showsPrec :: Int -> Range min max -> ShowS
$cshow :: forall (min :: Nat) (max :: Nat). Range min max -> String
show :: Range min max -> String
$cshowList :: forall (min :: Nat) (max :: Nat). [Range min max] -> ShowS
showList :: [Range min max] -> ShowS
Show, (forall x. Range min max -> Rep (Range min max) x)
-> (forall x. Rep (Range min max) x -> Range min max)
-> Generic (Range min max)
forall (min :: Nat) (max :: Nat) x.
Rep (Range min max) x -> Range min max
forall (min :: Nat) (max :: Nat) x.
Range min max -> Rep (Range min max) x
forall x. Rep (Range min max) x -> Range min max
forall x. Range min max -> Rep (Range min max) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (min :: Nat) (max :: Nat) x.
Range min max -> Rep (Range min max) x
from :: forall x. Range min max -> Rep (Range min max) x
$cto :: forall (min :: Nat) (max :: Nat) x.
Rep (Range min max) x -> Range min max
to :: forall x. Rep (Range min max) x -> Range min max
Generic)
    deriving newtype (Ord (Range min max)
Ord (Range min max) =>
((Range min max, Range min max) -> [Range min max])
-> ((Range min max, Range min max) -> Range min max -> Int)
-> ((Range min max, Range min max) -> Range min max -> Int)
-> ((Range min max, Range min max) -> Range min max -> Bool)
-> ((Range min max, Range min max) -> Int)
-> ((Range min max, Range min max) -> Int)
-> Ix (Range min max)
(Range min max, Range min max) -> Int
(Range min max, Range min max) -> [Range min max]
(Range min max, Range min max) -> Range min max -> Bool
(Range min max, Range min max) -> Range min max -> Int
forall (min :: Nat) (max :: Nat). Ord (Range min max)
forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Int
forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> [Range min max]
forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Range min max -> Bool
forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Range min max -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> [Range min max]
range :: (Range min max, Range min max) -> [Range min max]
$cindex :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Range min max -> Int
index :: (Range min max, Range min max) -> Range min max -> Int
$cunsafeIndex :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Range min max -> Int
unsafeIndex :: (Range min max, Range min max) -> Range min max -> Int
$cinRange :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Range min max -> Bool
inRange :: (Range min max, Range min max) -> Range min max -> Bool
$crangeSize :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Int
rangeSize :: (Range min max, Range min max) -> Int
$cunsafeRangeSize :: forall (min :: Nat) (max :: Nat).
(Range min max, Range min max) -> Int
unsafeRangeSize :: (Range min max, Range min max) -> Int
Ix, [Range min max] -> Value
[Range min max] -> Encoding
Range min max -> Bool
Range min max -> Value
Range min max -> Encoding
(Range min max -> Value)
-> (Range min max -> Encoding)
-> ([Range min max] -> Value)
-> ([Range min max] -> Encoding)
-> (Range min max -> Bool)
-> ToJSON (Range min max)
forall (min :: Nat) (max :: Nat). [Range min max] -> Value
forall (min :: Nat) (max :: Nat). [Range min max] -> Encoding
forall (min :: Nat) (max :: Nat). Range min max -> Bool
forall (min :: Nat) (max :: Nat). Range min max -> Value
forall (min :: Nat) (max :: Nat). Range min max -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall (min :: Nat) (max :: Nat). Range min max -> Value
toJSON :: Range min max -> Value
$ctoEncoding :: forall (min :: Nat) (max :: Nat). Range min max -> Encoding
toEncoding :: Range min max -> Encoding
$ctoJSONList :: forall (min :: Nat) (max :: Nat). [Range min max] -> Value
toJSONList :: [Range min max] -> Value
$ctoEncodingList :: forall (min :: Nat) (max :: Nat). [Range min max] -> Encoding
toEncodingList :: [Range min max] -> Encoding
$comitField :: forall (min :: Nat) (max :: Nat). Range min max -> Bool
omitField :: Range min max -> Bool
ToJSON, Range min max -> Text
Range min max -> ByteString
Range min max -> Builder
(Range min max -> Text)
-> (Range min max -> Builder)
-> (Range min max -> ByteString)
-> (Range min max -> Text)
-> (Range min max -> Builder)
-> ToHttpApiData (Range min max)
forall (min :: Nat) (max :: Nat). Range min max -> Text
forall (min :: Nat) (max :: Nat). Range min max -> ByteString
forall (min :: Nat) (max :: Nat). Range min max -> Builder
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: forall (min :: Nat) (max :: Nat). Range min max -> Text
toUrlPiece :: Range min max -> Text
$ctoEncodedUrlPiece :: forall (min :: Nat) (max :: Nat). Range min max -> Builder
toEncodedUrlPiece :: Range min max -> Builder
$ctoHeader :: forall (min :: Nat) (max :: Nat). Range min max -> ByteString
toHeader :: Range min max -> ByteString
$ctoQueryParam :: forall (min :: Nat) (max :: Nat). Range min max -> Text
toQueryParam :: Range min max -> Text
$ctoEncodedQueryParam :: forall (min :: Nat) (max :: Nat). Range min max -> Builder
toEncodedQueryParam :: Range min max -> Builder
ToHttpApiData)

unsafeRange :: Natural -> Range min max
unsafeRange :: forall (min :: Nat) (max :: Nat). Nat -> Range min max
unsafeRange = Nat -> Range min max
forall (min :: Nat) (max :: Nat). Nat -> Range min max
MkRange

instance (KnownNat min, KnownNat max) => Bounded (Range min max) where
    minBound :: Range min max
minBound = Nat -> Range min max
forall (min :: Nat) (max :: Nat). Nat -> Range min max
MkRange (Nat -> Range min max)
-> (Integer -> Nat) -> Integer -> Range min max
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Nat
forall a. Num a => Integer -> a
fromInteger (Integer -> Range min max) -> Integer -> Range min max
forall a b. (a -> b) -> a -> b
$ Proxy min -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @min)
    maxBound :: Range min max
maxBound = Nat -> Range min max
forall (min :: Nat) (max :: Nat). Nat -> Range min max
MkRange (Nat -> Range min max)
-> (Integer -> Nat) -> Integer -> Range min max
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Nat
forall a. Num a => Integer -> a
fromInteger (Integer -> Range min max) -> Integer -> Range min max
forall a b. (a -> b) -> a -> b
$ Proxy max -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @max)

parseErrorMsg :: forall min max. (KnownNat min, KnownNat max) => Proxy (Range min max) -> String
parseErrorMsg :: forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Proxy (Range min max) -> String
parseErrorMsg Proxy (Range min max)
_ =
    String
"Expecting a natural number between " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Proxy min -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @min)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Proxy max -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @max)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

mkRange :: forall min max. (KnownNat min, KnownNat max) => Natural -> Maybe (Range min max)
mkRange :: forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Nat -> Maybe (Range min max)
mkRange Nat
n
    | (Range min max, Range min max) -> Range min max -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Range min max
forall a. Bounded a => a
minBound :: Range min max, Range min max
forall a. Bounded a => a
maxBound :: Range min max) (Nat -> Range min max
forall (min :: Nat) (max :: Nat). Nat -> Range min max
MkRange Nat
n) = Range min max -> Maybe (Range min max)
forall a. a -> Maybe a
Just (Nat -> Range min max
forall (min :: Nat) (max :: Nat). Nat -> Range min max
MkRange Nat
n)
    | Bool
otherwise = Maybe (Range min max)
forall a. Maybe a
Nothing

instance (KnownNat min, KnownNat max) => FromJSON (Range min max) where
    parseJSON :: Value -> Parser (Range min max)
parseJSON Value
v = do
        Nat
n <- ShowS -> Parser Nat -> Parser Nat
forall a. ShowS -> Parser a -> Parser a
modifyFailure (String -> ShowS
forall a b. a -> b -> a
const (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Proxy (Range min max) -> String
parseErrorMsg @min @max Proxy (Range min max)
forall {k} (t :: k). Proxy t
Proxy) (Parser Nat -> Parser Nat) -> Parser Nat -> Parser Nat
forall a b. (a -> b) -> a -> b
$ Value -> Parser Nat
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Parser (Range min max)
-> (Range min max -> Parser (Range min max))
-> Maybe (Range min max)
-> Parser (Range min max)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (Range min max)
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Parser (Range min max))
-> String -> Parser (Range min max)
forall a b. (a -> b) -> a -> b
$ forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Proxy (Range min max) -> String
parseErrorMsg @min @max Proxy (Range min max)
forall {k} (t :: k). Proxy t
Proxy) Range min max -> Parser (Range min max)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Range min max) -> Parser (Range min max))
-> Maybe (Range min max) -> Parser (Range min max)
forall a b. (a -> b) -> a -> b
$ Nat -> Maybe (Range min max)
forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Nat -> Maybe (Range min max)
mkRange Nat
n

instance (KnownNat min, KnownNat max) => FromHttpApiData (Range min max) where
    parseQueryParam :: Text -> Either Text (Range min max)
parseQueryParam Text
v = do
        Nat
n <- (Text -> Text) -> Either Text Nat -> Either Text Nat
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> Text
forall a b. a -> b -> a
const (Text -> Text -> Text)
-> (String -> Text) -> String -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text -> Text) -> String -> Text -> Text
forall a b. (a -> b) -> a -> b
$ forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Proxy (Range min max) -> String
parseErrorMsg @min @max Proxy (Range min max)
forall {k} (t :: k). Proxy t
Proxy) (Either Text Nat -> Either Text Nat)
-> Either Text Nat -> Either Text Nat
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Nat
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
v
        Either Text (Range min max)
-> (Range min max -> Either Text (Range min max))
-> Maybe (Range min max)
-> Either Text (Range min max)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (Range min max)
forall a b. a -> Either a b
Left (Text -> Either Text (Range min max))
-> (String -> Text) -> String -> Either Text (Range min max)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Either Text (Range min max))
-> String -> Either Text (Range min max)
forall a b. (a -> b) -> a -> b
$ forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Proxy (Range min max) -> String
parseErrorMsg @min @max Proxy (Range min max)
forall {k} (t :: k). Proxy t
Proxy) Range min max -> Either Text (Range min max)
forall a b. b -> Either a b
Right (Maybe (Range min max) -> Either Text (Range min max))
-> Maybe (Range min max) -> Either Text (Range min max)
forall a b. (a -> b) -> a -> b
$ Nat -> Maybe (Range min max)
forall (min :: Nat) (max :: Nat).
(KnownNat min, KnownNat max) =>
Nat -> Maybe (Range min max)
mkRange Nat
n