{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies #-}
module Clckwrks.Redirect.URL where

import Data.Data (Data, Typeable)
import Data.SafeCopy               (SafeCopy(..), base, deriveSafeCopy)
import Clckwrks.Redirect.Acid      ()
import Clckwrks.Redirect.Types     ()
import Web.Routes.TH               (derivePathInfo)

data RedirectAdminURL
    = EditRedirects
      deriving (RedirectAdminURL -> RedirectAdminURL -> Bool
(RedirectAdminURL -> RedirectAdminURL -> Bool)
-> (RedirectAdminURL -> RedirectAdminURL -> Bool)
-> Eq RedirectAdminURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c/= :: RedirectAdminURL -> RedirectAdminURL -> Bool
== :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c== :: RedirectAdminURL -> RedirectAdminURL -> Bool
Eq, Eq RedirectAdminURL
Eq RedirectAdminURL
-> (RedirectAdminURL -> RedirectAdminURL -> Ordering)
-> (RedirectAdminURL -> RedirectAdminURL -> Bool)
-> (RedirectAdminURL -> RedirectAdminURL -> Bool)
-> (RedirectAdminURL -> RedirectAdminURL -> Bool)
-> (RedirectAdminURL -> RedirectAdminURL -> Bool)
-> (RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL)
-> (RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL)
-> Ord RedirectAdminURL
RedirectAdminURL -> RedirectAdminURL -> Bool
RedirectAdminURL -> RedirectAdminURL -> Ordering
RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL
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
min :: RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL
$cmin :: RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL
max :: RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL
$cmax :: RedirectAdminURL -> RedirectAdminURL -> RedirectAdminURL
>= :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c>= :: RedirectAdminURL -> RedirectAdminURL -> Bool
> :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c> :: RedirectAdminURL -> RedirectAdminURL -> Bool
<= :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c<= :: RedirectAdminURL -> RedirectAdminURL -> Bool
< :: RedirectAdminURL -> RedirectAdminURL -> Bool
$c< :: RedirectAdminURL -> RedirectAdminURL -> Bool
compare :: RedirectAdminURL -> RedirectAdminURL -> Ordering
$ccompare :: RedirectAdminURL -> RedirectAdminURL -> Ordering
$cp1Ord :: Eq RedirectAdminURL
Ord, Typeable RedirectAdminURL
DataType
Constr
Typeable RedirectAdminURL
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RedirectAdminURL -> c RedirectAdminURL)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RedirectAdminURL)
-> (RedirectAdminURL -> Constr)
-> (RedirectAdminURL -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RedirectAdminURL))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RedirectAdminURL))
-> ((forall b. Data b => b -> b)
    -> RedirectAdminURL -> RedirectAdminURL)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RedirectAdminURL -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RedirectAdminURL -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RedirectAdminURL -> m RedirectAdminURL)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RedirectAdminURL -> m RedirectAdminURL)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RedirectAdminURL -> m RedirectAdminURL)
-> Data RedirectAdminURL
RedirectAdminURL -> DataType
RedirectAdminURL -> Constr
(forall b. Data b => b -> b)
-> RedirectAdminURL -> RedirectAdminURL
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectAdminURL -> c RedirectAdminURL
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectAdminURL
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RedirectAdminURL -> u
forall u. (forall d. Data d => d -> u) -> RedirectAdminURL -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectAdminURL
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectAdminURL -> c RedirectAdminURL
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RedirectAdminURL)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectAdminURL)
$cEditRedirects :: Constr
$tRedirectAdminURL :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
gmapMp :: (forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
gmapM :: (forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RedirectAdminURL -> m RedirectAdminURL
gmapQi :: Int -> (forall d. Data d => d -> u) -> RedirectAdminURL -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RedirectAdminURL -> u
gmapQ :: (forall d. Data d => d -> u) -> RedirectAdminURL -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RedirectAdminURL -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectAdminURL -> r
gmapT :: (forall b. Data b => b -> b)
-> RedirectAdminURL -> RedirectAdminURL
$cgmapT :: (forall b. Data b => b -> b)
-> RedirectAdminURL -> RedirectAdminURL
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectAdminURL)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectAdminURL)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RedirectAdminURL)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RedirectAdminURL)
dataTypeOf :: RedirectAdminURL -> DataType
$cdataTypeOf :: RedirectAdminURL -> DataType
toConstr :: RedirectAdminURL -> Constr
$ctoConstr :: RedirectAdminURL -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectAdminURL
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectAdminURL
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectAdminURL -> c RedirectAdminURL
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectAdminURL -> c RedirectAdminURL
$cp1Data :: Typeable RedirectAdminURL
Data, Typeable, ReadPrec [RedirectAdminURL]
ReadPrec RedirectAdminURL
Int -> ReadS RedirectAdminURL
ReadS [RedirectAdminURL]
(Int -> ReadS RedirectAdminURL)
-> ReadS [RedirectAdminURL]
-> ReadPrec RedirectAdminURL
-> ReadPrec [RedirectAdminURL]
-> Read RedirectAdminURL
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RedirectAdminURL]
$creadListPrec :: ReadPrec [RedirectAdminURL]
readPrec :: ReadPrec RedirectAdminURL
$creadPrec :: ReadPrec RedirectAdminURL
readList :: ReadS [RedirectAdminURL]
$creadList :: ReadS [RedirectAdminURL]
readsPrec :: Int -> ReadS RedirectAdminURL
$creadsPrec :: Int -> ReadS RedirectAdminURL
Read, Int -> RedirectAdminURL -> ShowS
[RedirectAdminURL] -> ShowS
RedirectAdminURL -> String
(Int -> RedirectAdminURL -> ShowS)
-> (RedirectAdminURL -> String)
-> ([RedirectAdminURL] -> ShowS)
-> Show RedirectAdminURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedirectAdminURL] -> ShowS
$cshowList :: [RedirectAdminURL] -> ShowS
show :: RedirectAdminURL -> String
$cshow :: RedirectAdminURL -> String
showsPrec :: Int -> RedirectAdminURL -> ShowS
$cshowsPrec :: Int -> RedirectAdminURL -> ShowS
Show)
$(deriveSafeCopy 0 'base ''RedirectAdminURL)
$(derivePathInfo ''RedirectAdminURL)

data RedirectURL
    = Redirect
      deriving (RedirectURL -> RedirectURL -> Bool
(RedirectURL -> RedirectURL -> Bool)
-> (RedirectURL -> RedirectURL -> Bool) -> Eq RedirectURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedirectURL -> RedirectURL -> Bool
$c/= :: RedirectURL -> RedirectURL -> Bool
== :: RedirectURL -> RedirectURL -> Bool
$c== :: RedirectURL -> RedirectURL -> Bool
Eq, Eq RedirectURL
Eq RedirectURL
-> (RedirectURL -> RedirectURL -> Ordering)
-> (RedirectURL -> RedirectURL -> Bool)
-> (RedirectURL -> RedirectURL -> Bool)
-> (RedirectURL -> RedirectURL -> Bool)
-> (RedirectURL -> RedirectURL -> Bool)
-> (RedirectURL -> RedirectURL -> RedirectURL)
-> (RedirectURL -> RedirectURL -> RedirectURL)
-> Ord RedirectURL
RedirectURL -> RedirectURL -> Bool
RedirectURL -> RedirectURL -> Ordering
RedirectURL -> RedirectURL -> RedirectURL
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
min :: RedirectURL -> RedirectURL -> RedirectURL
$cmin :: RedirectURL -> RedirectURL -> RedirectURL
max :: RedirectURL -> RedirectURL -> RedirectURL
$cmax :: RedirectURL -> RedirectURL -> RedirectURL
>= :: RedirectURL -> RedirectURL -> Bool
$c>= :: RedirectURL -> RedirectURL -> Bool
> :: RedirectURL -> RedirectURL -> Bool
$c> :: RedirectURL -> RedirectURL -> Bool
<= :: RedirectURL -> RedirectURL -> Bool
$c<= :: RedirectURL -> RedirectURL -> Bool
< :: RedirectURL -> RedirectURL -> Bool
$c< :: RedirectURL -> RedirectURL -> Bool
compare :: RedirectURL -> RedirectURL -> Ordering
$ccompare :: RedirectURL -> RedirectURL -> Ordering
$cp1Ord :: Eq RedirectURL
Ord, Typeable RedirectURL
DataType
Constr
Typeable RedirectURL
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RedirectURL -> c RedirectURL)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RedirectURL)
-> (RedirectURL -> Constr)
-> (RedirectURL -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RedirectURL))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RedirectURL))
-> ((forall b. Data b => b -> b) -> RedirectURL -> RedirectURL)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RedirectURL -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RedirectURL -> r)
-> (forall u. (forall d. Data d => d -> u) -> RedirectURL -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RedirectURL -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL)
-> Data RedirectURL
RedirectURL -> DataType
RedirectURL -> Constr
(forall b. Data b => b -> b) -> RedirectURL -> RedirectURL
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectURL -> c RedirectURL
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectURL
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RedirectURL -> u
forall u. (forall d. Data d => d -> u) -> RedirectURL -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectURL
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectURL -> c RedirectURL
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RedirectURL)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectURL)
$cRedirect :: Constr
$tRedirectURL :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
gmapMp :: (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
gmapM :: (forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RedirectURL -> m RedirectURL
gmapQi :: Int -> (forall d. Data d => d -> u) -> RedirectURL -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RedirectURL -> u
gmapQ :: (forall d. Data d => d -> u) -> RedirectURL -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RedirectURL -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RedirectURL -> r
gmapT :: (forall b. Data b => b -> b) -> RedirectURL -> RedirectURL
$cgmapT :: (forall b. Data b => b -> b) -> RedirectURL -> RedirectURL
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectURL)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RedirectURL)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RedirectURL)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RedirectURL)
dataTypeOf :: RedirectURL -> DataType
$cdataTypeOf :: RedirectURL -> DataType
toConstr :: RedirectURL -> Constr
$ctoConstr :: RedirectURL -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectURL
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RedirectURL
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectURL -> c RedirectURL
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RedirectURL -> c RedirectURL
$cp1Data :: Typeable RedirectURL
Data, Typeable, ReadPrec [RedirectURL]
ReadPrec RedirectURL
Int -> ReadS RedirectURL
ReadS [RedirectURL]
(Int -> ReadS RedirectURL)
-> ReadS [RedirectURL]
-> ReadPrec RedirectURL
-> ReadPrec [RedirectURL]
-> Read RedirectURL
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RedirectURL]
$creadListPrec :: ReadPrec [RedirectURL]
readPrec :: ReadPrec RedirectURL
$creadPrec :: ReadPrec RedirectURL
readList :: ReadS [RedirectURL]
$creadList :: ReadS [RedirectURL]
readsPrec :: Int -> ReadS RedirectURL
$creadsPrec :: Int -> ReadS RedirectURL
Read, Int -> RedirectURL -> ShowS
[RedirectURL] -> ShowS
RedirectURL -> String
(Int -> RedirectURL -> ShowS)
-> (RedirectURL -> String)
-> ([RedirectURL] -> ShowS)
-> Show RedirectURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedirectURL] -> ShowS
$cshowList :: [RedirectURL] -> ShowS
show :: RedirectURL -> String
$cshow :: RedirectURL -> String
showsPrec :: Int -> RedirectURL -> ShowS
$cshowsPrec :: Int -> RedirectURL -> ShowS
Show)
$(deriveSafeCopy 0 'base ''RedirectURL)
$(derivePathInfo ''RedirectURL)