module Keys.UUID where
import Prelude
import Data.UUID (fromString, toString, toWords, fromWords)
import qualified Data.UUID as U (UUID, nil)
import Data.UUID.V4(nextRandom)
import Control.Applicative ((<$>))
import Data.Data
import Data.Hashable
import Data.Text (unpack, pack)
import Keys.Random
import Data.SafeCopy
import Data.Serialize
import Web.PathPieces
import Foreign.Storable
import Text.Blaze
newtype UUID = UUID U.UUID
deriving(Ord, Eq, Data, Typeable, Storable)
instance Show UUID where
show = strUUID
instance Read UUID where
readsPrec x y = map (\(a,b) -> (UUID a, b)) $ readsPrec x y
unUUID :: UUID -> U.UUID
unUUID (UUID u) = u
strUUID :: UUID -> String
strUUID (UUID u) = toString u
nil :: UUID
nil = UUID U.nil
instance Serialize UUID where
put (UUID u) = put $ toWords u
get = (UUID . (\(w1,w2,w3,w4) -> fromWords w1 w2 w3 w4)) `fmap` get
instance HasRandom UUID where
rnd = UUID `fmap` nextRandom
instance ToMarkup UUID where
toMarkup u = toMarkup $ pack $ strUUID u
instance Hashable UUID where
hashWithSalt i (UUID u) = hashWithSalt i (toWords u)
instance SafeCopy UUID where
putCopy (UUID u) = contain $ safePut $ toWords u
getCopy = contain $ (UUID . (\(a,b,c,d) -> fromWords a b c d) <$> safeGet)
instance PathPiece UUID where
fromPathPiece t = UUID <$> (fromString $ unpack t)
toPathPiece (UUID u) = pack $ toString u