{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-}
{- | This module provides a `UserId` type plus some useful instances for web development. -}
module Data.UserId where

import Control.Applicative ((<$>))
import Data.Aeson          (FromJSON(..), ToJSON(..), Result(..), fromJSON)
import Data.Data           (Data)
import Data.SafeCopy       (SafeCopy, base, deriveSafeCopy)
import Data.Serialize      (Serialize)
import Data.Typeable       (Typeable)
import GHC.Generics        (Generic)
import Text.Boomerang.TH   (makeBoomerangs)
import Web.Routes          (PathInfo(..))
import Web.Routes.TH       (derivePathInfo)

-- | a 'UserId' uniquely identifies a user.
newtype UserId = UserId { UserId -> Integer
_unUserId :: Integer }
    deriving (UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, Eq UserId
Eq UserId
-> (UserId -> UserId -> Ordering)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> UserId)
-> (UserId -> UserId -> UserId)
-> Ord UserId
UserId -> UserId -> Bool
UserId -> UserId -> Ordering
UserId -> UserId -> UserId
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 :: UserId -> UserId -> UserId
$cmin :: UserId -> UserId -> UserId
max :: UserId -> UserId -> UserId
$cmax :: UserId -> UserId -> UserId
>= :: UserId -> UserId -> Bool
$c>= :: UserId -> UserId -> Bool
> :: UserId -> UserId -> Bool
$c> :: UserId -> UserId -> Bool
<= :: UserId -> UserId -> Bool
$c<= :: UserId -> UserId -> Bool
< :: UserId -> UserId -> Bool
$c< :: UserId -> UserId -> Bool
compare :: UserId -> UserId -> Ordering
$ccompare :: UserId -> UserId -> Ordering
$cp1Ord :: Eq UserId
Ord, Int -> UserId
UserId -> Int
UserId -> [UserId]
UserId -> UserId
UserId -> UserId -> [UserId]
UserId -> UserId -> UserId -> [UserId]
(UserId -> UserId)
-> (UserId -> UserId)
-> (Int -> UserId)
-> (UserId -> Int)
-> (UserId -> [UserId])
-> (UserId -> UserId -> [UserId])
-> (UserId -> UserId -> [UserId])
-> (UserId -> UserId -> UserId -> [UserId])
-> Enum UserId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UserId -> UserId -> UserId -> [UserId]
$cenumFromThenTo :: UserId -> UserId -> UserId -> [UserId]
enumFromTo :: UserId -> UserId -> [UserId]
$cenumFromTo :: UserId -> UserId -> [UserId]
enumFromThen :: UserId -> UserId -> [UserId]
$cenumFromThen :: UserId -> UserId -> [UserId]
enumFrom :: UserId -> [UserId]
$cenumFrom :: UserId -> [UserId]
fromEnum :: UserId -> Int
$cfromEnum :: UserId -> Int
toEnum :: Int -> UserId
$ctoEnum :: Int -> UserId
pred :: UserId -> UserId
$cpred :: UserId -> UserId
succ :: UserId -> UserId
$csucc :: UserId -> UserId
Enum, ReadPrec [UserId]
ReadPrec UserId
Int -> ReadS UserId
ReadS [UserId]
(Int -> ReadS UserId)
-> ReadS [UserId]
-> ReadPrec UserId
-> ReadPrec [UserId]
-> Read UserId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserId]
$creadListPrec :: ReadPrec [UserId]
readPrec :: ReadPrec UserId
$creadPrec :: ReadPrec UserId
readList :: ReadS [UserId]
$creadList :: ReadS [UserId]
readsPrec :: Int -> ReadS UserId
$creadsPrec :: Int -> ReadS UserId
Read, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show, Typeable UserId
DataType
Constr
Typeable UserId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UserId -> c UserId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UserId)
-> (UserId -> Constr)
-> (UserId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UserId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId))
-> ((forall b. Data b => b -> b) -> UserId -> UserId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UserId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UserId -> r)
-> (forall u. (forall d. Data d => d -> u) -> UserId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UserId -> m UserId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserId -> m UserId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserId -> m UserId)
-> Data UserId
UserId -> DataType
UserId -> Constr
(forall b. Data b => b -> b) -> UserId -> UserId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
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) -> UserId -> u
forall u. (forall d. Data d => d -> u) -> UserId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
$cUserId :: Constr
$tUserId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UserId -> m UserId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapMp :: (forall d. Data d => d -> m d) -> UserId -> m UserId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapM :: (forall d. Data d => d -> m d) -> UserId -> m UserId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserId -> m UserId
gmapQi :: Int -> (forall d. Data d => d -> u) -> UserId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserId -> u
gmapQ :: (forall d. Data d => d -> u) -> UserId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserId -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserId -> r
gmapT :: (forall b. Data b => b -> b) -> UserId -> UserId
$cgmapT :: (forall b. Data b => b -> b) -> UserId -> UserId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UserId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserId)
dataTypeOf :: UserId -> DataType
$cdataTypeOf :: UserId -> DataType
toConstr :: UserId -> Constr
$ctoConstr :: UserId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserId -> c UserId
$cp1Data :: Typeable UserId
Data, Typeable, (forall x. UserId -> Rep UserId x)
-> (forall x. Rep UserId x -> UserId) -> Generic UserId
forall x. Rep UserId x -> UserId
forall x. UserId -> Rep UserId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserId x -> UserId
$cfrom :: forall x. UserId -> Rep UserId x
Generic, Get UserId
Putter UserId
Putter UserId -> Get UserId -> Serialize UserId
forall t. Putter t -> Get t -> Serialize t
get :: Get UserId
$cget :: Get UserId
put :: Putter UserId
$cput :: Putter UserId
Serialize)
deriveSafeCopy 1 'base ''UserId
-- makeLenses ''UserId
unUserId :: (Integer -> f Integer) -> UserId -> f UserId
unUserId Integer -> f Integer
f (UserId Integer
x) = (Integer -> UserId) -> f Integer -> f UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> UserId
UserId (Integer -> f Integer
f Integer
x)
{-# INLINE unUserId #-}
makeBoomerangs ''UserId

instance ToJSON   UserId where toJSON :: UserId -> Value
toJSON (UserId Integer
i) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
instance FromJSON UserId where parseJSON :: Value -> Parser UserId
parseJSON Value
v = Integer -> UserId
UserId (Integer -> UserId) -> Parser Integer -> Parser UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance PathInfo UserId where
    toPathSegments :: UserId -> [Text]
toPathSegments (UserId Integer
i) = Integer -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments Integer
i
    fromPathSegments :: URLParser UserId
fromPathSegments = Integer -> UserId
UserId (Integer -> UserId)
-> ParsecT [Text] () Identity Integer -> URLParser UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity Integer
forall url. PathInfo url => URLParser url
fromPathSegments

-- | get the next `UserId`
succUserId :: UserId -> UserId
succUserId :: UserId -> UserId
succUserId (UserId Integer
i) = Integer -> UserId
UserId (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
i)