-- |Representations of values that can serve as placeholders, being parsed from "Web.Route.Invertible.String" data.
{-# 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

-- |A parameter value @a@ that can be parsed from or rendered into string data @s@.
-- @parseParameter@ must invert @renderParameter@:
--
--   * @parseParameter . renderParameter == Just@
--   
class (RouteString s, Typeable a) => Parameter s a where
  -- |Parse string data into a value.
  -- Often equivalent (and defaults) to 'readMaybe'.
  parseParameter :: s -> Maybe a
  -- |Render a value into a string.
  -- Often equivalent (and defaults) to 'show'.
  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


-- |Parsers 'p' that operate over string data 's', and so can parse placeholder 'Parameter' values.
class Parameterized s p | p -> s where
  -- |Create a parser for a parameter of type 'a'.
  parameter :: Parameter s a => p a

-- |Create a placeholder 'parameter' with the type of the argument, which is ignored.
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

-- |An existential representation of an instance of @'Parameter' s@, that functions similarly to 'Data.Typeable.TypeRep' but also provides witness to a concrete instance.
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)

-- |Similar to 'typeRep'.
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)

-- |Constrain the type of 'parseParameter', ignoring the first parameter.
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