{-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.Util.Internal.Util ( Positive (..) , toPositive , unsafeToPositive , IsNotZero , KnownPositive , positiveVal ) where import Universum import Fmt (Buildable (..)) import GHC.TypeLits (ErrorMessage (..), TypeError) import Servant (FromHttpApiData (..), ToHttpApiData (..)) newtype Positive a = PositiveUnsafe { Positive a -> a unPositive :: a } deriving (Int -> Positive a -> ShowS [Positive a] -> ShowS Positive a -> String (Int -> Positive a -> ShowS) -> (Positive a -> String) -> ([Positive a] -> ShowS) -> Show (Positive a) forall a. Show a => Int -> Positive a -> ShowS forall a. Show a => [Positive a] -> ShowS forall a. Show a => Positive a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Positive a] -> ShowS $cshowList :: forall a. Show a => [Positive a] -> ShowS show :: Positive a -> String $cshow :: forall a. Show a => Positive a -> String showsPrec :: Int -> Positive a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Positive a -> ShowS Show, Positive a -> Positive a -> Bool (Positive a -> Positive a -> Bool) -> (Positive a -> Positive a -> Bool) -> Eq (Positive a) forall a. Eq a => Positive a -> Positive a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Positive a -> Positive a -> Bool $c/= :: forall a. Eq a => Positive a -> Positive a -> Bool == :: Positive a -> Positive a -> Bool $c== :: forall a. Eq a => Positive a -> Positive a -> Bool Eq, Eq (Positive a) Eq (Positive a) -> (Positive a -> Positive a -> Ordering) -> (Positive a -> Positive a -> Bool) -> (Positive a -> Positive a -> Bool) -> (Positive a -> Positive a -> Bool) -> (Positive a -> Positive a -> Bool) -> (Positive a -> Positive a -> Positive a) -> (Positive a -> Positive a -> Positive a) -> Ord (Positive a) Positive a -> Positive a -> Bool Positive a -> Positive a -> Ordering Positive a -> Positive a -> Positive a 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 forall a. Ord a => Eq (Positive a) forall a. Ord a => Positive a -> Positive a -> Bool forall a. Ord a => Positive a -> Positive a -> Ordering forall a. Ord a => Positive a -> Positive a -> Positive a min :: Positive a -> Positive a -> Positive a $cmin :: forall a. Ord a => Positive a -> Positive a -> Positive a max :: Positive a -> Positive a -> Positive a $cmax :: forall a. Ord a => Positive a -> Positive a -> Positive a >= :: Positive a -> Positive a -> Bool $c>= :: forall a. Ord a => Positive a -> Positive a -> Bool > :: Positive a -> Positive a -> Bool $c> :: forall a. Ord a => Positive a -> Positive a -> Bool <= :: Positive a -> Positive a -> Bool $c<= :: forall a. Ord a => Positive a -> Positive a -> Bool < :: Positive a -> Positive a -> Bool $c< :: forall a. Ord a => Positive a -> Positive a -> Bool compare :: Positive a -> Positive a -> Ordering $ccompare :: forall a. Ord a => Positive a -> Positive a -> Ordering $cp1Ord :: forall a. Ord a => Eq (Positive a) Ord) instance Buildable x => Buildable (Positive x) where build :: Positive x -> Builder build = x -> Builder forall p. Buildable p => p -> Builder build (x -> Builder) -> (Positive x -> x) -> Positive x -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . Positive x -> x forall a. Positive a -> a unPositive toPositive :: (Show a, Ord a, Num a) => a -> Either Text (Positive a) toPositive :: a -> Either Text (Positive a) toPositive a a | a a a -> a -> Bool forall a. Ord a => a -> a -> Bool > a 0 = Positive a -> Either Text (Positive a) forall a b. b -> Either a b Right (Positive a -> Either Text (Positive a)) -> Positive a -> Either Text (Positive a) forall a b. (a -> b) -> a -> b $ a -> Positive a forall a. a -> Positive a PositiveUnsafe a a | Bool otherwise = Text -> Either Text (Positive a) forall a b. a -> Either a b Left (Text -> Either Text (Positive a)) -> Text -> Either Text (Positive a) forall a b. (a -> b) -> a -> b $ Text "Non-positive value: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> a -> Text forall b a. (Show a, IsString b) => a -> b show a a unsafeToPositive :: (Show a, Ord a, Num a, HasCallStack) => a -> Positive a unsafeToPositive :: a -> Positive a unsafeToPositive = (Text -> Positive a) -> (Positive a -> Positive a) -> Either Text (Positive a) -> Positive a forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either Text -> Positive a forall a. HasCallStack => Text -> a error Positive a -> Positive a forall a. a -> a id (Either Text (Positive a) -> Positive a) -> (a -> Either Text (Positive a)) -> a -> Positive a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Either Text (Positive a) forall a. (Show a, Ord a, Num a) => a -> Either Text (Positive a) toPositive type family IsNotZero (k :: Nat) :: Constraint where IsNotZero 0 = TypeError ('Text "Null is now allowed here") IsNotZero k = () type KnownPositive k = (KnownNat k, IsNotZero k) positiveVal :: forall k i. (KnownPositive k, Num i) => Positive i positiveVal :: Positive i positiveVal = i -> Positive i forall a. a -> Positive a PositiveUnsafe (i -> Positive i) -> (Natural -> i) -> Natural -> Positive i forall b c a. (b -> c) -> (a -> b) -> a -> c . Natural -> i forall a b. (Integral a, Num b) => a -> b fromIntegral (Natural -> Positive i) -> Natural -> Positive i forall a b. (a -> b) -> a -> b $ Proxy k -> Natural forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Natural natVal @k Proxy k forall k (t :: k). Proxy t Proxy instance (FromHttpApiData a, Show a, Ord a, Num a) => FromHttpApiData (Positive a) where parseUrlPiece :: Text -> Either Text (Positive a) parseUrlPiece Text t = Text -> Either Text a forall a. FromHttpApiData a => Text -> Either Text a parseUrlPiece @a Text t Either Text a -> (a -> Either Text (Positive a)) -> Either Text (Positive a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= a -> Either Text (Positive a) forall a. (Show a, Ord a, Num a) => a -> Either Text (Positive a) toPositive instance ToHttpApiData a => ToHttpApiData (Positive a) where toUrlPiece :: Positive a -> Text toUrlPiece = ToHttpApiData a => a -> Text forall a. ToHttpApiData a => a -> Text toUrlPiece @a (a -> Text) -> (Positive a -> a) -> Positive a -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Positive a -> a forall a. Positive a -> a unPositive