packages feed

search (empty) → 0.1

raw patch · 10 files changed

+465/−0 lines, 10 filesdep +basedep +directorydep +doctestbuild-type:Customsetup-changed

Dependencies added: base, directory, doctest, filepath, ghc-prim, profunctors, search, semigroupoids, tagged, transformers

Files

+ .travis.yml view
@@ -0,0 +1,54 @@+language: haskell++env:+  - GHCVER=7.6.3+  - GHCVER=7.8.1++matrix:+  allow_failures:+    - env: GHCVER=head++before_install:+  # If $GHCVER is the one travis has, don't bother reinstalling it.+  # We can also have faster builds by installing some libraries with+  # `apt`. If it isn't, install the GHC we want from hvr's PPA along+  # with cabal-1.18.+  - |+    if [ $GHCVER = `ghc --numeric-version` ]; then+      # Try installing some of the build-deps with apt-get for speed.+      travis/cabal-apt-install --enable-tests $MODE+      export CABAL=cabal+    else+      # Install the GHC we want from hvr's PPA+      travis_retry sudo add-apt-repository -y ppa:hvr/ghc+      travis_retry sudo apt-get update+      travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy+      export CABAL=cabal-1.18+      export PATH=/opt/ghc/$GHCVER/bin:$PATH+    fi+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && $CABAL update+  - $CABAL update++  # Update happy when building with GHC head+  - |+    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.1" ]; then+      $CABAL install happy alex+      export PATH=$HOME/.cabal/bin:$PATH+    fi++install:+  - $CABAL install --dependencies-only --enable-tests+  - $CABAL configure --enable-tests $MODE++script:+  - $CABAL build+  - $CABAL test --show-details=always++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313search\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"
+ .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"
+ CHANGELOG.markdown view
@@ -0,0 +1,3 @@+0.1+---+* Repository initialized
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2014 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.++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,16 @@+search+======++[![Build Status](https://secure.travis-ci.org/ekmett/search.png?branch=master)](http://travis-ci.org/ekmett/search)+++This package provides a version of Martin Escardo's "J" monad for conducting "infinite search in finite time".++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the `#haskell` or `#haskell-lens` IRC channels on `irc.freenode.net`.++-Edward Kmett
+ Setup.lhs view
@@ -0,0 +1,44 @@+#!/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), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+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+  }++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}
+ search.cabal view
@@ -0,0 +1,53 @@+name:          search+category:      Math, Topology, Search+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/ekmett/search/+bug-reports:   http://github.com/ekmett/search/issues+copyright:     Copyright (C) 2014 Edward A. Kmett+synopsis:      Infinite search in finite time with Hilbert's epsilon+description:   Infinite search in finite time with Hilbert's epsilon+build-type:    Custom+extra-source-files:+  .travis.yml+  .vim.custom+  travis/config+  CHANGELOG.markdown+  README.markdown++source-repository head+  type: git+  location: git://github.com/ekmett/search.git++library+  build-depends:+    base                 >= 4.5   && < 5,+    ghc-prim,+    profunctors          >= 4     && < 5,+    semigroupoids        >= 4     && < 5,+    tagged               >= 0.7   && < 1,+    transformers         >= 0.3   && < 0.4++  exposed-modules:+    Data.Search++  ghc-options: -Wall -fwarn-tabs -O2+  hs-source-dirs: src++-- Verify the results of the examples+test-suite doctests+  type:           exitcode-stdio-1.0+  main-is:        doctests.hs+  ghc-options:    -Wall -Werror -threaded+  hs-source-dirs: tests+  build-depends:+    base,+    directory >= 1.0 && < 1.3,+    doctest   >= 0.8 && < 0.10,+    filepath  >= 1.3 && < 1.4,+    search
+ src/Data/Search.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Search+  ( Search(..)+  , pessimum+  , optimalScore, pessimalScore+  , cps+  , union+  , pair+  , fromList+  -- *  Hilbert's epsilon+  , Hilbert(..)+  , best, worst+  , bestScore, worstScore+  -- * Boolean-valued search+  , every+  , exists+  ) where++import Control.Applicative+import Control.Monad.Trans.Cont+import Data.Function (on)+import Data.Functor.Alt+import Data.Functor.Bind+import Data.Int+import Data.Monoid+import Data.Ord+import Data.Profunctor+import Data.Proxy+import Data.Tagged+import Data.Typeable+import Data.Word+import GHC.Generics++-- | Given a test that is required to execute in finite time for _all_ inputs, even infinite ones,+-- 'Search' should productively yield an answer.+--+-- I currently also assume that comparison of scores can be done in finite time for all scores.+--+-- This rules out large score sets.+--+-- @'Search' 'Bool'@ can be used for predicate searches.+newtype Search a b = Search { optimum :: (b -> a) -> b }+  deriving Typeable++-- | Find the worst-scoring result of a search.+pessimum :: Search (Down a) b -> (b -> a) -> b+pessimum = optimum . lmap Down++instance Profunctor Search where+  dimap f g (Search k) = Search $ \ba -> g (k (f.ba.g))+  {-# INLINE dimap #-}++instance Functor (Search a) where+  fmap f (Search k) = Search $ \ba -> f (k (ba.f))+  {-# INLINE fmap #-}++instance Apply (Search a) where+  (<.>) = (<*>)+  {-# INLINE (<.>) #-}++instance Applicative (Search a) where+  pure b = Search $ \_ -> b+  fs <*> as = Search $ \p ->+    let go q = q $ optimum as (p.q)+    in  go $ optimum fs (p.go)++instance Ord a => Alt (Search a) where+  l <!> r = Search go where+    go p+      | p a >= p b = a+      | otherwise  = b+      where+        a = optimum l p+        b = optimum r p++instance Bind (Search a) where+  Search ma >>- f = Search $ \p ->+    optimum (f (ma (\a -> p (optimum (f a) p)))) p++instance Monad (Search a) where+  return a = Search $ \_ -> a+  Search ma >>= f = Search $ \p ->+    optimum (f (ma (\a -> p (optimum (f a) p)))) p++-- | <http://en.wikipedia.org/wiki/Epsilon_calculus#Hilbert_notation Hilbert's epsilon>+class Hilbert a b where+  epsilon :: Search a b+  default epsilon :: (GHilbert a (Rep b), Generic b) => Search a b+  epsilon = to <$> gepsilon++-- | Generic derivation of Hilbert's epsilon.+class GHilbert a f where+  gepsilon :: Search a (f b)++instance GHilbert a U1 where+  gepsilon = pure U1++instance (GHilbert a f, GHilbert a g) => GHilbert a (f :*: g) where+  gepsilon = liftA2 (:*:) gepsilon gepsilon++instance (GHilbert a f, GHilbert a g, Ord a) => GHilbert a (f :+: g) where+  gepsilon = L1 <$> gepsilon <!> R1 <$> gepsilon++instance Hilbert a b => GHilbert a (K1 i b) where+  gepsilon = K1 <$> epsilon++instance GHilbert a f => GHilbert a (M1 i c f) where+  gepsilon = M1 <$> gepsilon++instance Hilbert x ()+instance Hilbert x (Proxy a) where epsilon = pure Proxy+instance Hilbert x a => Hilbert x (Tagged s a) where epsilon = Tagged <$> epsilon+instance (Hilbert x a, Hilbert x b) => Hilbert x (a, b)+instance (Hilbert x a, Hilbert x b, Hilbert x c) => Hilbert x (a, b, c)+instance (Hilbert x a, Hilbert x b, Hilbert x c, Hilbert x d) => Hilbert x (a, b, c, d)+instance (Hilbert x a, Hilbert x b, Hilbert x c, Hilbert x d, Hilbert x e) => Hilbert x (a, b, c, d, e)+instance Ord x => Hilbert x Bool+instance Ord x => Hilbert x Any where epsilon = Any <$> epsilon+instance Ord x => Hilbert x All where epsilon = All <$> epsilon+instance Hilbert x a => Hilbert x (Product a) where epsilon = Product <$> epsilon+instance Hilbert x a => Hilbert x (Sum a) where epsilon = Sum <$> epsilon+instance Ord x => Hilbert x Ordering+instance Ord x => Hilbert x Char where epsilon = fromList [minBound .. maxBound]+instance Ord x => Hilbert x Int8 where epsilon = fromList [minBound .. maxBound]+instance Ord x => Hilbert x Int16 where epsilon = fromList [minBound .. maxBound]+instance Ord x => Hilbert x Word8 where epsilon = fromList [minBound .. maxBound]+instance Ord x => Hilbert x Word16 where epsilon = fromList [minBound .. maxBound]+instance (Ord x, Hilbert x a) => Hilbert x [a]+instance (Ord x, Hilbert x a) => Hilbert x (ZipList a) where epsilon = ZipList <$> epsilon+instance (Ord x, Hilbert x a) => Hilbert x (Maybe a)+instance (Ord x, Hilbert x a) => Hilbert x (First a) where epsilon = First <$> epsilon+instance (Ord x, Hilbert x a) => Hilbert x (Last a) where epsilon = Last <$> epsilon+instance (Ord x, Hilbert x a, Hilbert x b) => Hilbert x (Either a b)+instance (Ord x, Ord a, Hilbert x b) => Hilbert x (Search a b) where+  epsilon = fromList <$> epsilon++-- | What is the best score obtained by the search?+optimalScore :: Search a b -> (b -> a) -> a+optimalScore m p = p (optimum m p)++-- | What is the worst score obtained by the search?+pessimalScore :: Search (Down a) b -> (b -> a) -> a+pessimalScore m p = p (pessimum m p)++-- | search for an optimal answer using Hilbert's epsilon+--+-- >>> search (>4) :: Int8+-- 5+best :: Hilbert a b => (b -> a) -> b+best = optimum epsilon++-- | What is the worst scoring answer by Hilbert's epsilon?+worst :: Hilbert (Down a) b => (b -> a) -> b+worst = pessimum epsilon++bestScore :: Hilbert a b => (b -> a) -> a+bestScore = optimalScore epsilon++worstScore :: Hilbert (Down a) b => (b -> a) -> a+worstScore = pessimalScore epsilon++-- | does there exist an element satisfying the predicate?+--+-- >>> exists (>(maxBound::Int8))+-- False+--+exists :: Hilbert Bool b => (b -> Bool) -> Bool+exists = bestScore++every :: Hilbert Bool b => (b -> Bool) -> Bool+every p = not.p $ best $ not.p++union :: Ord a => Search a b -> Search a b -> Search a b+union = (<!>)++pair :: Ord a => b -> b -> Search a b+pair = on (<!>) pure++fromList :: Ord a => [b] -> Search a b+fromList = foldr1 (<!>) . map return++-- | 'Search' is more powerful than 'Cont'.+--+-- This provides a canonical monad homomorphism into 'Cont'.+cps :: Search a b -> Cont a b+cps = cont . optimalScore
+ tests/doctests.hs view
@@ -0,0 +1,30 @@+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++main :: IO ()+main = getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : 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/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