{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- ---------------------------------------------------------------------------- {- | Module : Hunt.Index.Common.DocId Copyright : Copyright (C) 2014 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) The document identifier type DocId and the newtype DocId' with Show and ToJSOn instances -} -- ---------------------------------------------------------------------------- module Hunt.Common.DocId where import Control.Applicative import Data.Aeson import Data.Binary (Binary (..)) import qualified Data.Binary as B import Data.Digest.Murmur64 -- ------------------------------------------------------------ {- -- | The unique identifier of a document. type DocId = Int -- ------------------------------------------------------------ -- | Create the null-identifier. mkNull :: DocId mkNull = 0 -- | Create the first identifier. mkFirst :: DocId mkFirst = 1 -- | Create a 'DocId' from an 'Integer'. fromInteger :: Integer -> DocId fromInteger = fromIntegral -- ------------------------------------------------------------ {-# INLINE mkNull #-} {-# INLINE mkFirst #-} {-# INLINE fromInteger #-} -- -} -- ------------------------------------------------------------ -- the wrapped DocId -- currently only used for JSON debug output newtype DocId = DocId {unDocId :: Int} deriving (Eq, Ord) instance Show DocId where show = toHex . unDocId instance Binary DocId where put = put . unDocId get = DocId <$> get instance ToJSON DocId where toJSON (DocId i) = toJSON $ toHex i mkDocId :: Binary a => a -> DocId mkDocId = DocId . fromIntegral . asWord64 . hash64 . B.encode toHex :: Int -> String toHex !y = "0x" ++ toX 16 "" y where toX :: Int -> String -> Int -> String toX !0 !acc _ = acc toX !n !acc x = toX (n - 1) (d : acc) x' where (!x', !r) = x `divMod` 16 !d | r < 10 = toEnum (fromEnum '0' + r) | otherwise = toEnum (fromEnum 'a' + r - 10) fromHex :: String -> Maybe Int fromHex i@('0' : 'x' : xs) | length xs == 16 && all (`elem` "0123456789abcdef") xs = Just . read $ i | otherwise = Nothing fromHex _ = Nothing -- ------------------------------------------------------------