Cabalized

.ghci

@@ -0,0 +1 @@
+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h

.gitignore

@@ -0,0 +1,9 @@
+dist
+docs
+wiki
+TAGS
+tags
+wip
+.DS_Store
+.*.swp
+.*.swo

.travis.yml

@@ -0,0 +1,25 @@
+language: haskell
+before_install:
+  # Uncomment whenever hackage is down.
+  # - mkdir -p ~/.cabal && cp config ~/.cabal/config && cabal update
+
+  # Try installing some of the build-deps with apt-get for speed.
+  - ./travis-cabal-apt-install --only-dependencies --force-reinstall $mode
+
+install:
+  - cabal configure $mode
+  - cabal build
+
+script:
+  - $script
+
+notifications:
+  irc:
+    channels:
+      - "irc.freenode.org#happs"
+    skip_join: true
+    template:
+      - "\x0313tables\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"
+
+env:
+  - mode="--enable-tests" script="cabal test --show-details=always"

.vim.custom

@@ -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

@@ -0,0 +1,3 @@
+0.1
+---
+* Repository Initialized

LICENSE

@@ -0,0 +1,30 @@
+Copyright 2012 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

@@ -0,0 +1,15 @@
+Tables
+======
+
+[![Build Status](https://secure.travis-ci.org/ekmett/tables.png?branch=master)](http://travis-ci.org/ekmett/tables)
+
+This package provides a simple in memory data table with multiple indices.
+
+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

@@ -0,0 +1,42 @@
+#!/usr/bin/runhaskell
+\begin{code}
+module Main (main) where
+
+import Data.List ( nub )
+import Data.Version ( showVersion )
+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )
+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )
+import Distribution.Verbosity ( Verbosity )
+import Distribution.Simple.BuildPaths ( autogenModulesDir )
+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )
+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(libraryConfig, testSuiteConfigs), ComponentLocalBuildInfo(componentPackageDeps) )
+import System.FilePath ( (</>) )
+
+main :: IO ()
+main = defaultMainWithHooks simpleUserHooks
+  { buildHook = \pkg lbi hooks flags -> do
+     generateBuildModule "doctests" (fromFlag (buildVerbosity flags)) lbi
+     buildHook simpleUserHooks pkg lbi hooks flags
+  }
+
+generateBuildModule :: String -> Verbosity -> LocalBuildInfo -> IO ()
+generateBuildModule testSuite verbosity lbi = do
+  let dir = autogenModulesDir lbi
+  createDirectoryIfMissingVerbose verbosity True dir
+  rewriteFile (dir </> "Build_" ++ testSuite ++ ".hs") $ unlines
+    [ "module Build_" ++ testSuite ++ " where"
+    , "deps :: [String]"
+    , "deps = " ++ (show $ formatdeps (testDeps testSuite lbi))
+    ]
+  where
+    formatdeps = map (formatone . snd)
+    formatone p = case packageName p of
+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
+
+testDeps :: String -> LocalBuildInfo -> [(InstalledPackageId, PackageId)]
+testDeps testSuite lbi = nub $
+     maybe [] componentPackageDeps (lookup testSuite (testSuiteConfigs lbi))
+  ++ maybe [] componentPackageDeps (libraryConfig lbi)
+
+\end{code}

examples/Foo.hs

@@ -0,0 +1,83 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LiberalTypeSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+module Foo where
+
+import Control.Applicative hiding (empty)
+import Control.Lens
+import Data.Foldable as Foldable
+import Data.Function (on)
+import Data.Functor.Identity
+import Data.List ((\\))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Monoid
+import Data.Proxy
+import Data.Table
+import Data.Traversable
+import Prelude.Extras
+import qualified Prelude
+import Prelude hiding (null)
+
+-- * Example Table
+
+data Foo a = Foo { __fooId :: Int, __fooBar :: a, __fooBaz :: Double }
+  deriving (Eq,Ord,Show,Read)
+
+makeLenses ''Foo
+
+class HasFooKeys t a | t -> a where
+  foo    :: Simple Lens t (Foo a)
+  fooId  :: Key Primary t Int
+  fooBar :: Key Other t a
+  fooBaz :: Key (Secondary NonUnique) t Double
+
+instance HasFooKeys (Foo a) a where
+  foo    = id
+  fooId  = key FooId
+  fooBar = key FooBar
+  fooBaz = key FooBaz
+
+instance Tabular (Foo a) where
+  type PKT (Foo a) = Int
+  data Column (Foo a) k b where
+    FooId  :: Column (Foo a) Primary Int
+    FooBar :: Column (Foo a) Other a
+    FooBaz :: Column (Foo a) (Secondary NonUnique) Double
+
+  data Tab (Foo a) = FooTab
+    {-# UNPACK #-} !Int
+    (Index (Foo a) Primary Int)
+    (Index (Foo a) Other a)
+    (Index (Foo a) (Secondary NonUnique) Double)
+
+  val FooId  = _fooId
+  val FooBar = _fooBar
+  val FooBaz = _fooBaz
+
+  primaryKey = fooId
+
+  primarily (Fob FooId) r = r
+
+  tabulate f = FooTab 0 (f fooId) (f fooBar) (f fooBaz)
+
+  ixMeta (FooTab _ x _ _) (Fob FooId)  = x
+  ixMeta (FooTab _ _ x _) (Fob FooBar) = x
+  ixMeta (FooTab _ _ _ x) (Fob FooBaz) = x
+
+  forMeta (FooTab n x y z) f = FooTab n <$> f fooId x <*> f fooBar y <*> f fooBaz z
+
+  prim = indexed $ \ f (FooTab n x y z) -> f (FooId :: Column (Foo a) Primary Int) x <&> \x' -> FooTab n x' y z
+
+  autoKey = autoIncrement $ \f (FooTab n x y z) -> f n <&> \n' -> FooTab n' x y z
+
+test :: Table (Foo String)
+test = [Foo 0 "One" 1.0, Foo 0 "Two" 2.0, Foo 0 "Three" 3.0, Foo 0 "Four" 4.0, Foo 0 "Five" 5.0]^.table