{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, ExistentialQuantification, EmptyCase, DefaultSignatures, FunctionalDependencies #-}
module Web.Route.Invertible.Parameter
( Parameter(..)
, Parameterized(..)
, param
, ParameterType(..)
, parameterTypeOf
, parseParameterAs
) where
import Control.Monad (guard)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Hashable (Hashable(..))
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64)
import Data.Proxy (Proxy(Proxy))
import Data.String (IsString(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Read as T
import Data.Typeable (Typeable, typeRep)
import Data.Void (Void, absurd)
import Text.Read (readMaybe)
import Web.Route.Invertible.String
class (RouteString s, Typeable a) => Parameter s a where
parseParameter :: s -> Maybe a
renderParameter :: a -> s
default parseParameter :: Read a => s -> Maybe a
parseParameter = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (s -> String) -> s -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall s. RouteString s => s -> String
toString
default renderParameter :: Show a => a -> s
renderParameter = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (a -> String) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
instance {-# OVERLAPPABLE #-} (RouteString s) => Parameter s String where
parseParameter :: s -> Maybe String
parseParameter = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> (s -> String) -> s -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall s. RouteString s => s -> String
toString
renderParameter :: String -> s
renderParameter = String -> s
forall a. IsString a => String -> a
fromString
instance Parameter T.Text T.Text where
parseParameter :: Text -> Maybe Text
parseParameter = Text -> Maybe Text
forall a. a -> Maybe a
Just
renderParameter :: Text -> Text
renderParameter = Text -> Text
forall a. a -> a
id
instance Parameter BS.ByteString BS.ByteString where
parseParameter :: ByteString -> Maybe ByteString
parseParameter = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
renderParameter :: ByteString -> ByteString
renderParameter = ByteString -> ByteString
forall a. a -> a
id
instance Parameter T.Text BS.ByteString where
parseParameter :: Text -> Maybe ByteString
parseParameter = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Text -> ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
renderParameter :: ByteString -> Text
renderParameter = ByteString -> Text
TE.decodeUtf8
instance Parameter BS.ByteString T.Text where
parseParameter :: ByteString -> Maybe Text
parseParameter = (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TE.decodeUtf8'
renderParameter :: Text -> ByteString
renderParameter = Text -> ByteString
TE.encodeUtf8
instance Parameter String Char where
parseParameter :: String -> Maybe Char
parseParameter [Char
c] = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
parseParameter String
_ = Maybe Char
forall a. Maybe a
Nothing
renderParameter :: Char -> String
renderParameter Char
c = [Char
c]
instance Parameter T.Text Char where
parseParameter :: Text -> Maybe Char
parseParameter = String -> Maybe Char
forall s a. Parameter s a => s -> Maybe a
parseParameter (String -> Maybe Char) -> (Text -> String) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
renderParameter :: Char -> Text
renderParameter = Char -> Text
T.singleton
instance Parameter BS.ByteString Char where
parseParameter :: ByteString -> Maybe Char
parseParameter = String -> Maybe Char
forall s a. Parameter s a => s -> Maybe a
parseParameter (String -> Maybe Char)
-> (ByteString -> String) -> ByteString -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
renderParameter :: Char -> ByteString
renderParameter = Char -> ByteString
BSC.singleton
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Integer
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Int
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Int8
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Int16
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Int32
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Int64
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Word
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Word8
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Word16
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Word32
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Word64
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Float
instance {-# OVERLAPPABLE #-} RouteString s => Parameter s Double
readText :: T.Reader a -> T.Text -> Maybe a
readText :: Reader a -> Text -> Maybe a
readText = (Either String (a, Text) -> Maybe a) -> Reader a -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((Either String (a, Text) -> Maybe a)
-> Reader a -> Text -> Maybe a)
-> (Either String (a, Text) -> Maybe a)
-> Reader a
-> Text
-> Maybe a
forall a b. (a -> b) -> a -> b
$ (String -> Maybe a)
-> ((a, Text) -> Maybe a) -> Either String (a, Text) -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (\(a
a, Text
t) -> a
a a -> Maybe () -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Bool
T.null Text
t))
instance Parameter T.Text Integer where parseParameter :: Text -> Maybe Integer
parseParameter = Reader Integer -> Text -> Maybe Integer
forall a. Reader a -> Text -> Maybe a
readText (Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
T.signed Reader Integer
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Int where parseParameter :: Text -> Maybe Int
parseParameter = Reader Int -> Text -> Maybe Int
forall a. Reader a -> Text -> Maybe a
readText (Reader Int -> Reader Int
forall a. Num a => Reader a -> Reader a
T.signed Reader Int
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Int8 where parseParameter :: Text -> Maybe Int8
parseParameter = Reader Int8 -> Text -> Maybe Int8
forall a. Reader a -> Text -> Maybe a
readText (Reader Int8 -> Reader Int8
forall a. Num a => Reader a -> Reader a
T.signed Reader Int8
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Int16 where parseParameter :: Text -> Maybe Int16
parseParameter = Reader Int16 -> Text -> Maybe Int16
forall a. Reader a -> Text -> Maybe a
readText (Reader Int16 -> Reader Int16
forall a. Num a => Reader a -> Reader a
T.signed Reader Int16
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Int32 where parseParameter :: Text -> Maybe Int32
parseParameter = Reader Int32 -> Text -> Maybe Int32
forall a. Reader a -> Text -> Maybe a
readText (Reader Int32 -> Reader Int32
forall a. Num a => Reader a -> Reader a
T.signed Reader Int32
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Int64 where parseParameter :: Text -> Maybe Int64
parseParameter = Reader Int64 -> Text -> Maybe Int64
forall a. Reader a -> Text -> Maybe a
readText (Reader Int64 -> Reader Int64
forall a. Num a => Reader a -> Reader a
T.signed Reader Int64
forall a. Integral a => Reader a
T.decimal)
instance Parameter T.Text Word where parseParameter :: Text -> Maybe Word
parseParameter = Reader Word -> Text -> Maybe Word
forall a. Reader a -> Text -> Maybe a
readText Reader Word
forall a. Integral a => Reader a
T.decimal
instance Parameter T.Text Word8 where parseParameter :: Text -> Maybe Word8
parseParameter = Reader Word8 -> Text -> Maybe Word8
forall a. Reader a -> Text -> Maybe a
readText Reader Word8
forall a. Integral a => Reader a
T.decimal
instance Parameter T.Text Word16 where parseParameter :: Text -> Maybe Word16
parseParameter = Reader Word16 -> Text -> Maybe Word16
forall a. Reader a -> Text -> Maybe a
readText Reader Word16
forall a. Integral a => Reader a
T.decimal
instance Parameter T.Text Word32 where parseParameter :: Text -> Maybe Word32
parseParameter = Reader Word32 -> Text -> Maybe Word32
forall a. Reader a -> Text -> Maybe a
readText Reader Word32
forall a. Integral a => Reader a
T.decimal
instance Parameter T.Text Word64 where parseParameter :: Text -> Maybe Word64
parseParameter = Reader Word64 -> Text -> Maybe Word64
forall a. Reader a -> Text -> Maybe a
readText Reader Word64
forall a. Integral a => Reader a
T.decimal
instance Parameter T.Text Float where parseParameter :: Text -> Maybe Float
parseParameter = Reader Float -> Text -> Maybe Float
forall a. Reader a -> Text -> Maybe a
readText Reader Float
forall a. Fractional a => Reader a
T.rational
instance Parameter T.Text Double where parseParameter :: Text -> Maybe Double
parseParameter = Reader Double -> Text -> Maybe Double
forall a. Reader a -> Text -> Maybe a
readText Reader Double
T.double
instance RouteString s => Parameter s Void where
parseParameter :: s -> Maybe Void
parseParameter s
_ = Maybe Void
forall a. Maybe a
Nothing
renderParameter :: Void -> s
renderParameter = Void -> s
forall a. Void -> a
absurd
class Parameterized s p | p -> s where
parameter :: Parameter s a => p a
param :: (Parameterized s p, Parameter s a) => a -> p a
param :: a -> p a
param a
_ = p a
forall s (p :: * -> *) a. (Parameterized s p, Parameter s a) => p a
parameter
data ParameterType s = forall a . Parameter s a => ParameterType !(Proxy a)
instance Eq (ParameterType s) where
ParameterType Proxy a
a == :: ParameterType s -> ParameterType s -> Bool
== ParameterType Proxy a
b = Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b
instance Ord (ParameterType s) where
ParameterType Proxy a
a compare :: ParameterType s -> ParameterType s -> Ordering
`compare` ParameterType Proxy a
b = Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b
instance Hashable (ParameterType s) where
hashWithSalt :: Int -> ParameterType s -> Int
hashWithSalt Int
s (ParameterType Proxy a
d) = Int -> TypeRep -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
d)
instance Show (ParameterType s) where
showsPrec :: Int -> ParameterType s -> ShowS
showsPrec Int
d (ParameterType Proxy a
p) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"ParameterType " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TypeRep -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p)
parameterTypeOf :: forall s proxy a . Parameter s a => proxy a -> ParameterType s
parameterTypeOf :: proxy a -> ParameterType s
parameterTypeOf proxy a
_ = Proxy a -> ParameterType s
forall s a. Parameter s a => Proxy a -> ParameterType s
ParameterType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
parseParameterAs :: forall s proxy a . Parameter s a => proxy a -> s -> Maybe a
parseParameterAs :: proxy a -> s -> Maybe a
parseParameterAs proxy a
_ = s -> Maybe a
forall s a. Parameter s a => s -> Maybe a
parseParameter