-- |Allow more general "Web.Route.Invertible.Parameter" placeholders that include fixed strings.
{-# LANGUAGE GADTs, FlexibleInstances, MultiParamTypeClasses #-}
module Web.Route.Invertible.Placeholder
  ( Placeholder(..)
  , renderPlaceholder
  , PlaceholderValue(..)
  , renderPlaceholderValue
  ) where

import Data.Function (on)
import Data.String (IsString(..))
import Data.Typeable (typeRep, typeOf)

import Web.Route.Invertible.String
import Web.Route.Invertible.Parameter

-- |A segment of a parser over strings @s@, which may be a fixed string (usually created through 'IsString'), only accepting a single fixed value, or a dynamic parameter (created through 'Parameterized'), which encapsulates a 'Parameter' type.
data Placeholder s a where
  PlaceholderFixed :: !s -> Placeholder s ()
  PlaceholderParameter :: Parameter s a => Placeholder s a

instance Eq s => Eq (Placeholder s a) where
  PlaceholderFixed s
x == :: Placeholder s a -> Placeholder s a -> Bool
== PlaceholderFixed s
y = s
x s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
y
  Placeholder s a
PlaceholderParameter == Placeholder s a
PlaceholderParameter = Bool
True
  Placeholder s a
_ == Placeholder s a
_ = Bool
False

instance Ord s => Ord (Placeholder s a) where
  PlaceholderFixed s
x compare :: Placeholder s a -> Placeholder s a -> Ordering
`compare` PlaceholderFixed s
y = s
x s -> s -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` s
y
  PlaceholderFixed s
_ `compare` Placeholder s a
PlaceholderParameter = Ordering
LT
  Placeholder s a
PlaceholderParameter `compare` PlaceholderFixed s
_ = Ordering
GT
  Placeholder s a
PlaceholderParameter `compare` Placeholder s a
PlaceholderParameter = Ordering
EQ

instance Show s => Show (Placeholder s a) where
  showsPrec :: Int -> Placeholder s a -> ShowS
showsPrec Int
d (PlaceholderFixed s
s) = 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
"PlaceholderFixed " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> s -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 s
s
  showsPrec Int
d p :: Placeholder s a
p@Placeholder s a
PlaceholderParameter = 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
"PlaceholderParameter " 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 (Placeholder s a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Placeholder s a
p)

instance IsString s => IsString (Placeholder s ()) where
  fromString :: String -> Placeholder s ()
fromString = s -> Placeholder s ()
forall s. s -> Placeholder s ()
PlaceholderFixed (s -> Placeholder s ())
-> (String -> s) -> String -> Placeholder s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString

instance RouteString s => Parameterized s (Placeholder s) where
  parameter :: Placeholder s a
parameter = Placeholder s a
forall s a. Parameter s a => Placeholder s a
PlaceholderParameter

-- |Render a placeholder into a string, as fixed text or using 'renderParameter'.
renderPlaceholder :: Placeholder s a -> a -> s
renderPlaceholder :: Placeholder s a -> a -> s
renderPlaceholder (PlaceholderFixed s
s) () = s
s
renderPlaceholder Placeholder s a
PlaceholderParameter a
a = a -> s
forall s a. Parameter s a => a -> s
renderParameter a
a

-- |A concrete, untyped representation of a parsed 'Placeholder' value, distinguishing fixed components from parameters but abstracting over the parsed type.
data PlaceholderValue s where
  PlaceholderValueFixed :: !s -> PlaceholderValue s
  PlaceholderValueParameter :: Parameter s a => a -> PlaceholderValue s

instance Eq s => Eq (PlaceholderValue s) where
  == :: PlaceholderValue s -> PlaceholderValue s -> Bool
(==) = (s -> s -> Bool)
-> (PlaceholderValue s -> s)
-> PlaceholderValue s
-> PlaceholderValue s
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on s -> s -> Bool
forall a. Eq a => a -> a -> Bool
(==) PlaceholderValue s -> s
forall s. PlaceholderValue s -> s
renderPlaceholderValue

instance Ord s => Ord (PlaceholderValue s) where
  compare :: PlaceholderValue s -> PlaceholderValue s -> Ordering
compare = (s -> s -> Ordering)
-> (PlaceholderValue s -> s)
-> PlaceholderValue s
-> PlaceholderValue s
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on s -> s -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PlaceholderValue s -> s
forall s. PlaceholderValue s -> s
renderPlaceholderValue

instance (RouteString s, Show s) => Show (PlaceholderValue s) where
  showsPrec :: Int -> PlaceholderValue s -> ShowS
showsPrec Int
d (PlaceholderValueFixed s
s) = 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
"PlaceholderValueFixed " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> s -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 s
s
  showsPrec Int
d p :: PlaceholderValue s
p@(PlaceholderValueParameter a
a) = 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
"PlaceholderValueParameter (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
showString (s -> String
forall s. RouteString s => s -> String
toString (s -> String) -> s -> String
forall a b. (a -> b) -> a -> b
$ PlaceholderValue s -> s
forall s. PlaceholderValue s -> s
renderPlaceholderValue PlaceholderValue s
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
showString String
" :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    TypeRep -> ShowS
forall a. Show a => a -> ShowS
shows (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Char -> ShowS
showChar Char
')'

-- |Render a placeholder into a string, as fixed text or using 'renderParameter'.
renderPlaceholderValue :: PlaceholderValue s -> s
renderPlaceholderValue :: PlaceholderValue s -> s
renderPlaceholderValue (PlaceholderValueFixed s
s) = s
s
renderPlaceholderValue (PlaceholderValueParameter a
a) = a -> s
forall s a. Parameter s a => a -> s
renderParameter a
a