cmph (empty) → 0.0.1
raw patch · 9 files changed
+266/−0 lines, 9 filesdep +QuickCheckdep +arraydep +basesetup-changed
Dependencies added: QuickCheck, array, base, bytestring, cmph, containers, hspec, semigroups, text
Files
- Data/CMPH.hs +88/−0
- LICENSE +29/−0
- README +1/−0
- Setup.hs +2/−0
- cmph.cabal +39/−0
- stub.c +47/−0
- stub.h +8/−0
- test/Data/CMPHSpec.hs +51/−0
- test/Main.hs +1/−0
+ Data/CMPH.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+++module Data.CMPH ( CMPH, hash, buildHash, size ) where+import Control.Exception (bracket)+import Control.Monad (guard, liftM)+import Data.Array+import Data.Array.IO (IOArray, newArray, newArray_,+ writeArray)+import Data.Array.Storable (StorableArray, withStorableArray)+import Data.Array.Unsafe (unsafeFreeze)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Unsafe as Unsafe+import Data.Monoid+import qualified Data.Set as Set+import Data.Word+import Foreign (Ptr)+import Foreign.C.String (CString)+import Foreign.C.Types+import Foreign.Marshal.Array ()+import GHC.Arr (unsafeAt)+import Prelude hiding (lookup)+import System.IO.Unsafe (unsafePerformIO)++data ForeignHash++foreign import ccall unsafe "stub.h cmph_search" c_cmph_search+ :: Ptr ForeignHash -> CString -> CUInt -> IO CULong+foreign import ccall unsafe "stub.h build_hash" c_build_hash+ :: Ptr CString -> CUInt -> IO (Ptr ForeignHash)+foreign import ccall unsafe "stub.h free_ptrs" c_free_ptrs+ :: CUInt -> Ptr CString -> IO ()+foreign import ccall unsafe "string.h strdup" c_strdup+ :: CString -> IO CString++data CMPH = CMPH { rawHash :: Ptr ForeignHash+ , size :: Word32+ }++-- we pull a few dumb tricks to get around some partiality in libcmph.+--+-- no empty strings allowed+-- so prepend 'a' to all strings+-- can't hash an empty list+-- so add an element to empty lists.+-- no repeats+-- strip them out before passing to the c lib+-- can't have embedded nulls in the inserted strings+-- return Nothing. Too hard.++buildHash :: [BS.ByteString] -> IO (Maybe CMPH)+buildHash input'+ | all noNull input' = do+ let input = uniqued ("":"b":input')+ let len = fromIntegral $ length input+ raw <-+ bracket (buildCPtrs (map ("a"<>) input))+ (freeCPtrs len)+ (\a -> withStorableArray a (`c_build_hash` (CUInt len)))+ return $ Just $ CMPH raw len+ | otherwise = return Nothing++uniqued :: Ord a => [a] -> [a]+uniqued = Set.toList . Set.fromList++noNull :: BS.ByteString -> Bool+noNull = (==Nothing) . S.find (=='\NUL')++hash :: CMPH-> BS.ByteString -> IO Word64+hash cmph bs = do+ (CULong w) <- S.useAsCStringLen ("a"<>bs) $ \(cstr,len) -> c_cmph_search (rawHash cmph) cstr (CUInt $ fromIntegral len)+ return w++freeCPtrs :: Word32+ -> StorableArray Int CString+ -> IO ()+freeCPtrs len arr = withStorableArray arr $ c_free_ptrs (CUInt len)++buildCPtrs bs = do+ buffer <- newArray_ (0,length bs-1)+ (`mapM_` (zip [0..] bs)) $ \(i,bs) ->+ S.useAsCStringLen bs $ \(cstr,len) -> do+ writeArray buffer i =<< c_strdup cstr+ return buffer
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009 Mark Wotton <mwotton@gmail.com>+(Microbench copyright Evan Martin <martine@danga.com>)++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:+* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+* Neither the name of the author nor the names of contributors may be+ used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
@@ -0,0 +1,1 @@+This is a thin haskell wrapper around the CMPH library, obtainable at http://cmph.sf.net.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cmph.cabal view
@@ -0,0 +1,39 @@+Name: cmph+Version: 0.0.1+Cabal-Version: >= 1.10+License: BSD3+License-File: LICENSE+Build-Type: Simple+Author: Mark Wotton <mwotton@gmail.com>+Maintainer: Mark Wotton <mwotton@gmail.com>+Category: Data, Data Structures+Stability: Experimental+extra-source-files: stub.h, README+bug-reports: mailto:mwotton@gmail.com+Synopsis: low level interface to CMPH+Description: a binding to the C-based CMPH library (http://cmph.sf.net).++library+ Exposed-Modules: Data.CMPH+ default-language: Haskell2010+ ghc-options: -funbox-strict-fields+ c-sources: stub.c+ includes: stub.h+ extra-libraries: cmph+ build-depends: base >=4.5 && <5.2+ , bytestring+ , containers+ , array++test-suite cmph-test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: Data.CMPHSpec+ build-depends: cmph, base, hspec, QuickCheck, containers, bytestring, semigroups, text+ extra-libraries: cmph++source-repository head+ type: git+ location: http://github.com/mwotton/hscmph.git
+ stub.c view
@@ -0,0 +1,47 @@+#include "stub.h"+#include <stdio.h>+#include <string.h>+#include <cmph.h>++/* alas, BDZ is not defined in 0.7, so we need a fallback */+// #ifdef CMPH_BDZ+// #define CMPH_ALGO CMPH_BDZ+// #else+//+// #define CMPH_ALGO CMPH_BMZ+// #endif++#define CMPH_ALGO CMPH_CHD++/* void monkey_debug(char ** v, unsigned int nkeys) { */+/* for (int i=0; i< nkeys; i++) { */+/* fprintf(stderr, "monkey %d: %s\n", i, v[i]); */+/* } */+/* } */++/* unsigned long cmph_search_mark(cmph_t * hash, char * str, unsigned long len) { */+/* unsigned long i = cmph_search(hash,str,len); */+/* fprintf(stderr,"search got %lu for %s, length %lu\n", i, str,len); */+/* return i; */+/* } */++cmph_t * build_hash(char ** vector, unsigned int nkeys) {+ // fprintf(stderr, "building hash with %d keys, first is %s, last is %s\n", nkeys, *vector, vector[nkeys-1]);+ cmph_io_adapter_t *source = cmph_io_vector_adapter(vector, nkeys);+ // fprintf(stderr, "building adapter is %p\n", source);+ cmph_config_t *config = cmph_config_new(source);+ // fprintf(stderr, "building config is %p\n", config);+ cmph_config_set_algo(config, CMPH_ALGO);+ cmph_t *hash = cmph_new(config);+ // cmph_config_destroy(config);+ // fprintf(stderr, "building hash is %p\n", hash);+ // monkey_debug(vector, nkeys);+ if(!hash) { fprintf(stderr, "Dying horribly, hash is null\n"); exit(1); }+ return hash;+}++void free_ptrs(unsigned int nkeys, char ** strings) {+ for (unsigned int i = 0; i<nkeys; i++) {+ free(strings[i]);+ }+}
+ stub.h view
@@ -0,0 +1,8 @@+#ifndef __HASH_STUB_H__+#define __HASH_STUB_H__++#include <cmph.h>++unsigned long stub_hash(cmph_t* hash, char * word);+cmph_t * build_hash(char ** vector, unsigned int nkeys);+#endif
+ test/Data/CMPHSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.CMPHSpec where++import Control.Monad (guard)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Char+import qualified Data.CMPH as CMPH+import qualified Data.List as DL+import qualified Data.List.NonEmpty as NEL+import Data.Maybe (isNothing)+import Data.Monoid ((<>))+import Data.Ord (comparing)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Data.Word+import Test.Hspec+import Test.Hspec.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck++main = hspec spec++letterGen = arbitrary `suchThat` (\c -> c /= '\NUL')+stringGen = BS8.pack <$> listOf letterGen+stringListGen = listOf stringGen++unique s = Set.size (Set.fromList s) == length s++spec = modifyMaxSuccess (const 1000) $ describe "cmph" $ do+ it "gives up early if there's a NUL in there" $ do+ property+ $ forAll (stringListGen `suchThat` (not . null)) $ \strings' -> do+ let strings = map (\a -> a <> "\NUL" <> a) strings'+ ph <- CMPH.buildHash strings+ fmap (const "cmph") ph `shouldSatisfy` isNothing++ it "does not generate dupes if the input contains no nulls " $ do+ property+-- $ (const 500)++ $ forAll stringListGen $ \strings -> do+ -- print ("strings", strings)+ Just ph <- CMPH.buildHash strings+ -- print ("builtstrings", strings)+ -- we unique them here: it's ok to pass in dupes, but for+ -- correctness purposes, it's the uniqued size we care about+ results <- mapM (CMPH.hash ph) (Set.toList $ Set.fromList strings)+ -- print ("results", DL.sortBy (comparing snd) $ zip strings results)+ DL.sort results `shouldSatisfy` unique
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}