packages feed

hash (empty) → 0.1

raw patch · 17 files changed

+731/−0 lines, 17 filesdep +basedep +bifunctorsdep +bytestringbuild-type:Customsetup-changed

Dependencies added: base, bifunctors, bytestring, data-default, directory, doctest, filepath, generic-deriving, hashable, lens, transformers

Files

+ .ghci view
@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h
+ .gitignore view
@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
+ .travis.yml view
@@ -0,0 +1,26 @@+language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - travis/cabal-apt-install $mode++install:+  - cabal configure -flib-Werror $mode+  - cabal build++script:+  - $script && hlint src --cpp-define HLINT++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313hashable-extras\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test --show-details=always"
+ .vim.custom view
@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"
+ AUTHORS.markdown view
@@ -0,0 +1,15 @@+Analytics was started by [Edward Kmett](https://github.com/ekmett) in response to a question by [Alec Heller](https://github.com/deviant-logic) about if he should use `bound` to implement datalog. It has since somewhat expanded in scope.++`hash` was split out of the `analytics` repository.++The suggestion for adding `Hashable1` and `Hashable2` came from prolonged discussions on the topic with Dan Doel. However, any errors in the implementation are my fault.++* [Dan Doel](mailto:dan.doel@gmail.com) [@dolio](https://github.com/dolio)++You can watch contributors carry on the quest for bragging rights in the [contributors graph](https://github.com/analytics/compensated/graphs/contributors).++Omission from this list is by no means an attempt to discount your contribution.++Thank you for all of your help!++-Edward Kmett
+ CHANGELOG.markdown view
@@ -0,0 +1,4 @@+0.1+---+* Added `Data.Hashable.Extras` in the style of `prelude-extras` and `syb-extras` for higher rank hashing.+* Split from [https://github.com/analytics/analytics](analytics)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2012-2013 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.markdown view
@@ -0,0 +1,15 @@+hash+====++[![Build Status](https://secure.travis-ci.org/ekmett/hash.png?branch=master)](http://travis-ci.org/ekmett/hash)++This package provides a bunch of hashing machinery.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett
+ Setup.lhs view
@@ -0,0 +1,55 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
+ hash.cabal view
@@ -0,0 +1,82 @@+name:          hash+category:      Data, Hash+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/analytics/hash/+bug-reports:   http://github.com/analytics/hash/issues+copyright:     Copyright (C) 2013 Edward A. Kmett+build-type:    Custom+tested-with:   GHC == 7.4.1, GHC == 7.6.1+synopsis:      Hashing tools+description:   Hashing tools++extra-source-files:+  .travis.yml+  .ghci+  .gitignore+  .vim.custom+  travis/cabal-apt-install+  travis/config+  AUTHORS.markdown+  README.markdown+  CHANGELOG.markdown++source-repository head+  type: git+  location: git://github.com/analytics/hash.git++-- You can disable the doctests test suite with -f-test-doctests+flag test-doctests+  default: True+  manual: True++flag lib-Werror+  default: False+  manual: True++library++  build-depends:+    base             >= 4.3      && < 5,+    bifunctors       >= 3.2      && < 4,+    bytestring       >= 0.9      && < 0.11,+    data-default     >= 0.5      && < 0.7,+    generic-deriving == 1.4.*,+    hashable         >= 1.1.2.3  && < 1.3,+    lens             >= 3.8      && < 4,+    transformers     >= 0.2      && < 0.4++  exposed-modules:+    Data.Hashable.Extras+    Data.Hash.CRC32+    Data.Hash.Double+    Data.Hash.Rolling++  if flag(lib-Werror)+    ghc-options: -Werror++  ghc-options: -Wall -fwarn-tabs -O2+  hs-source-dirs: src++test-suite doctests+  type:           exitcode-stdio-1.0+  main-is:        doctests.hs+  ghc-options:    -Wall -threaded+  hs-source-dirs: tests++  if !flag(test-doctests)+    buildable: False+  else+    build-depends:+      base,+      directory      >= 1.0,+      doctest        >= 0.9.1,+      filepath++  if impl(ghc<7.6.1)+    ghc-options: -Werror
+ src/Data/Hash/CRC32.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Hash.CRC32+  ( CRC32+  , updated+  , final+  ) where++import Control.Lens+import Data.Bits+import Data.Default+import Data.Monoid+import Data.Word+import Foreign.Storable+import Foreign.Ptr+import GHC.Base++------------------------------------------------------------------------------+-- CRC32+------------------------------------------------------------------------------++newtype CRC32 = CRC32 { getCRC32 :: Word32 }++instance Default CRC32 where+  def = CRC32 0xffffffff;+  {-# INLINE def #-}++instance (Bifunctor p, Profunctor p, Functor f) => Snoc p f CRC32 CRC32 Word8 Word8 where+  _Snoc = unto $ \(CRC32 h, w) -> CRC32 (shiftL h 8 `xor` lut w)+  {-# INLINE _Snoc #-}++updated :: Getting (Endo (Endo CRC32)) t Word8 -> t -> CRC32 -> CRC32+updated l t z = foldlOf' l snoc z t+{-# INLINE updated #-}++final :: CRC32 -> Word32+final = complement . getCRC32+{-# INLINE final #-}++------------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------------++foreign import ccall "static &crc32_lut" crc32_lut :: Ptr Word32++#ifndef HLINT+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of+  (# _, r #) -> r+{-# INLINE inlinePerformIO #-}+#endif++lut :: Word8 -> Word32+lut i = inlinePerformIO (peekElemOff crc32_lut (fromIntegral i))+{-# INLINE lut #-}
+ src/Data/Hash/Double.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Hash.Double+  ( Hash(..)+  , sip+  , pepper+  ) where++import Control.Applicative+import Control.Lens+import Data.Data+import Data.Hashable+import Generics.Deriving++-- $setup+-- >>> :load Data.Hash.Double+-- >>> import Control.Lens++-- | \"Less Hashing, Same Performance: Building a Better Bloom Filter\" by+-- Kirsch and Mitzenmacher demonstrated that for many use-cases, especially+-- involving Bloom filters, we can use pairwise independent hashes to+-- generate a family of related hash functions with good characteristics.+--+-- <http://www.eecs.harvard.edu/~kirsch/pubs/bbbf/rsa.pdf>+--+-- This stores a pair of hashes.+--+-- >>> sip (42 :: Int)^..taking 4 each+-- [-2574874314062730062,-9186383815474761572,2648850756822758536,-3962658744589272970]+--+-- >>> sip (42 :: Int)^.ix 3+-- -3962658744589272970+data Hash = Hash {-# UNPACK #-} !Int {-# UNPACK #-} !Int+  deriving (Eq,Ord,Show,Read,Data,Typeable,Generic)++sip :: Hashable a => a -> Hash+sip a = Hash (hash a)                -- hash with the salt taken from Data.Hash+             (hashWithSalt pepper a) -- chosen by fair die roll+{-# INLINE sip #-}++pepper :: Int+pepper = 0x53dffa872f4d7341++type instance Index Hash   = Int+type instance IxValue Hash = Int++instance Gettable f => Contains f Hash where+  contains i f _ = coerce $ indexed f (i :: Int) True+  {-# INLINE contains #-}++instance Gettable f => Ixed f Hash where+  ix i f (Hash a b) = coerce $ indexed f i (a + i * (b + i))+  {-# INLINE ix #-}++instance (Gettable f, Applicative f) => Each f Hash Hash Int Int where+  each f (Hash a b) = go 0 where+    go !i = indexed f i (a + i*(b+i)) *> go (i + 1)+  {-# INLINE each #-}
+ src/Data/Hash/Rolling.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE PatternGuards #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Hash.Rolling+  ( roll'+  , roll+  ) where++import Data.Bits+import Data.ByteString as B+import Data.ByteString.Lazy as L+import Data.Monoid+import Data.Int+import Data.Word+import Foreign.Storable+import Foreign.Ptr+import GHC.Base++foreign import ccall "static &rolling_lut" rolling_lut :: Ptr Int32++#ifndef HLINT+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of+  (# _, r #) -> r+{-# INLINE inlinePerformIO #-}+#endif++lut :: Word8 -> Int32+lut i = inlinePerformIO (peekElemOff rolling_lut (fromIntegral i))+{-# INLINE lut #-}++update :: Int32 -> Word8 -> Word8 -> Int32+update hash x y = rotateR hash 1 `xor` lut x `xor` lut y+{-# INLINE update #-}++-- | Take a strict 'S.ByteString' and generate a new lazy 'L.ByteString' with chunks based on a rolling+-- hash. This generates chunks with an expected size of 8k, where the sizes vary between 128 bytes and 64k each.+-- and the breakpoints are based on moments where a rolling hash function applied to the last 128 bytes of the+-- input matches a mask.+--+-- This can be used with various chunk hashing schemes to allow hashing that is fairly robust in the+-- presence of inline insertions and deletions.+--+-- The rolling hash is based on the ideas from @buzhash@, but since we have a known window size that is an+-- integral multiple of the word size we save work.+roll :: L.ByteString -> L.ByteString+roll z = L.fromChunks $ go seed 0 z (L.unpack (L.replicate window 0 <> z)) (L.unpack z) where+  go !h !c !bs (x:xs) (y:ys)+    | ((h' .&. mask == mask) && c >= minSize) || c >= maxSize = case L.splitAt (c + 1) bs of+       (l,r) -> B.concat (L.toChunks l) : go seed 0 r xs ys+    | otherwise = go h' (c + 1) bs xs ys+    where !h' = update h (if c < window then 0 else x) y+  go _ _ bs _ _ = [B.concat $ L.toChunks bs]+  mask     = 8191+  minSize  = 128+  maxSize  = 65536+  window   = 128+  seed     = 0 :: Int32+{-# INLINE roll #-}+-- TODO: use bytestring internals to optimize the concatenations with their known length+-- TODO: split out a separate init loop to run the minSize/window length to avoid the conditional in the inner loop+--       and the repeated check against the min size.+-- TODO: use bytestring internals to avoid constructing a bunch of intermediate lists.++-- |+-- Calculates @powqp m n p = 'rem' (m^n) p@ under the assumption that @m * p * p@ can fit in an @Int64@.+powqp :: Int64 -> Int64 -> Int64 -> Int64+powqp _ 0 _ = 1+powqp m 1 p = rem m p+powqp m n p = case quotRem n 2 of+  (q, 1) | k <- powqp m q p -> rem (k * k * m) p+  (q, _) | k <- powqp m q p -> rem (k * k) p+{-# INLINE powqp #-}++-- | Take a 'L.ByteString' and generate a new 'L.ByteString' with chunks based on a rolling+-- hash. This generates chunks with an expected size of 8k, where the sizes vary between 128 bytes and 64k each.+-- and the breakpoints are based on moments where a rolling hash function applied to the last 128 bytes of the+-- input matches a mask.+--+-- This can be used with various chunk hashing schemes to allow hashing that is fairly robust in the+-- presence of inline insertions and deletions.+--+-- This scheme is based on the standard Rabin-Karp rolling checksum. It is much slower than 'rolling', but+-- is provided here for comparison purposes.+roll' :: L.ByteString -> L.ByteString+roll' z = L.fromChunks $ go seed 0 z (L.unpack (L.replicate window 0 <> z)) (L.unpack z) where+  go !h !c !bs (x:xs) (y:ys)+    | ((h' .&. mask == mask) && c >= minSize) || c >= maxSize = case L.splitAt (c + 1) bs of+       (l,r) -> B.concat (L.toChunks l) : go seed 0 r xs ys+    | otherwise = go h' (c + 1) bs xs ys+    where+      !x' = if c < window then 0 else fromIntegral x+      !h' = rem (rem (h - magic_d * x') magic_q * magic_r + fromIntegral y) magic_q+  go _ _ bs _ _ = [B.concat $ L.toChunks bs]+  magic_d = powqp magic_r (window-1) magic_q+  mask    = 8191+  minSize = 128+  maxSize = 65536+  magic_r = 256+  magic_q = 32749+  window  = 128+  seed = 0+{-# INLINE roll' #-}
+ src/Data/Hashable/Extras.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DefaultSignatures #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Hashable.Extras+  ( Hashable1(..)+  , Hashable2(..)+  , Hashed(..)+  , hashWith1+  , hashWith2+  , salt+  ) where++import Data.Bifunctor+import Data.Functor.Identity+import Data.Hashable++data Hashed = Hashed { unhashed :: Int -> Int }++instance Hashable Hashed where+  hashWithSalt n f = unhashed f n+  {-# INLINE hashWithSalt #-}++data Salt = Salt++instance Hashable Salt where+  hashWithSalt = const+  {-# INLINE hashWithSalt #-}++-- | Extract the default salt used by `Data.Hashable`+salt :: Int+salt = hash Salt++class Hashable1 t where+  hashWithSalt1 :: Hashable a => Int -> t a -> Int+  default hashWithSalt1 :: (Hashable a, Hashable (t a)) => Int -> t a -> Int+  hashWithSalt1 = hashWithSalt1+  {-# INLINE hashWithSalt1 #-}++  hash1 :: Hashable a => t a -> Int+  hash1 = hashWithSalt1 salt+  {-# INLINE hash1 #-}++instance Hashable1 Identity where+  hashWithSalt1 n (Identity a) = hashWithSalt n a+  {-# INLINE hashWithSalt1 #-}++instance Hashable1 Maybe+instance Hashable1 []+instance Hashable a => Hashable1 (Either a)+instance Hashable a => Hashable1 ((,) a)+instance (Hashable a, Hashable b) => Hashable1 ((,,) a b)+instance (Hashable a, Hashable b, Hashable c) => Hashable1 ((,,,) a b c)+instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable1 ((,,,,) a b c d)+instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable1 ((,,,,,) a b c d e)+instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e, Hashable f) => Hashable1 ((,,,,,,) a b c d e f)++class Hashable2 t where+  hashWithSalt2 :: (Hashable a, Hashable b) => Int -> t a b -> Int+  default hashWithSalt2 :: (Hashable a, Hashable b, Hashable (t a b)) => Int -> t a b -> Int+  hashWithSalt2 = hashWithSalt+  {-# INLINE hashWithSalt2 #-}++  hash2 :: (Hashable a, Hashable b) => t a b -> Int+  hash2 = hashWithSalt2 salt+  {-# INLINE hash2 #-}++instance Hashable2 Either+instance Hashable2 (,)+instance Hashable a => Hashable2 ((,,) a)+instance (Hashable a, Hashable b) => Hashable2 ((,,,) a b)+instance (Hashable a, Hashable b, Hashable c) => Hashable2 ((,,,,) a b c)+instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable2 ((,,,,,) a b c d)+instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable2 ((,,,,,,) a b c d e)++hashWith1 :: (Functor t, Hashable1 t) => (Int -> a -> Int) -> Int -> t a -> Int+hashWith1 h s ta = s `hashWithSalt1` fmap (\a -> Hashed (`h` a)) ta+{-# INLINE hashWith1 #-}++hashWith2 :: (Bifunctor t, Hashable2 t) => (Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int+hashWith2 h1 h2 s tab = s `hashWithSalt2` bimap (\a -> Hashed (`h1` a)) (\b -> Hashed (`h2` b)) tab+{-# INLINE hashWith2 #-}
+ tests/doctests.hsc view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##if defined(mingw32_HOST_OS)+##if defined(i386_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : "-Iincludes"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ travis/cabal-apt-install view
@@ -0,0 +1,27 @@+#! /bin/bash+set -eu++APT="sudo apt-get -q -y"+CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall"++$APT update+$APT install dctrl-tools++# Find potential system packages to satisfy cabal dependencies+deps()+{+	local M='^\([^ ]\+\)-[0-9.]\+ (.*$'+	local G=' -o ( -FPackage -X libghc-\L\1\E-dev )'+	local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \+		| sed -ne "s/$M/$G/p" | sort -u)"+	grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u+}++$APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special+$CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage++if ! $APT install hlint ; then+	$APT install $(deps hlint)+	cabal install hlint+fi+
+ travis/config view
@@ -0,0 +1,16 @@+-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix+--+-- This is particularly useful for travis-ci to get it to stop complaining+-- about a broken build when everything is still correct on our end.+--+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead+--+-- To enable this, uncomment the before_script in .travis.yml++remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive+remote-repo-cache: ~/.cabal/packages+world-file: ~/.cabal/world+build-summary: ~/.cabal/logs/build.log+remote-build-reporting: anonymous+install-dirs user+install-dirs global