packages feed

tables 0.3 → 0.3.1

raw patch · 4 files changed

+61/−32 lines, 4 filessetup-changed

Files

CHANGELOG.markdown view
@@ -1,3 +1,8 @@+0.3.1+-----+* Improved `Setup.lhs` to work with more versions of `cabal`.+* Internal compatibility with changes in `lens` 3.10 to `anon`.+ 0.3 --- * Instances for `SafeCopy`, `Binary` and `Cereal`
Setup.lhs view
@@ -1,42 +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), PackageId, InstalledPackageId, packageVersion, packageName )+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 )-import Distribution.Verbosity ( Verbosity )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )-import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(libraryConfig, testSuiteConfigs), ComponentLocalBuildInfo(componentPackageDeps) )+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 "doctests" (fromFlag (buildVerbosity flags)) lbi+     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   } -generateBuildModule :: String -> Verbosity -> LocalBuildInfo -> IO ()-generateBuildModule testSuite verbosity lbi = do+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-  rewriteFile (dir </> "Build_" ++ testSuite ++ ".hs") $ unlines-    [ "module Build_" ++ testSuite ++ " where"-    , "deps :: [String]"-    , "deps = " ++ (show $ formatdeps (testDeps testSuite lbi))-    ]+  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 :: String -> LocalBuildInfo -> [(InstalledPackageId, PackageId)]-testDeps testSuite lbi = nub $-     maybe [] componentPackageDeps (lookup testSuite (testSuiteConfigs lbi))-  ++ maybe [] componentPackageDeps (libraryConfig lbi)+testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys  \end{code}
src/Data/Table.hs view
@@ -73,7 +73,7 @@  import Control.Applicative hiding (empty) import Control.Comonad-import Control.Lens+import Control.Lens hiding (anon) import Control.Monad import Control.Monad.Fix import Data.Binary (Binary)@@ -148,7 +148,7 @@ -- -- To enable auto-increment for a table with primary key @primaryKeyField@, set: ----- @'autoKey' = 'autoIncrement' primaryKeyField@+-- @'autoTab' = 'autoIncrement' primaryKeyField@ autoIncrement :: (Tabular t, Num (PKT t)) => ALens' t (PKT t) -> t -> Maybe (Tab t (AnIndex t) -> t) autoIncrement pk t   | t ^# pk == 0 = Just $ \ tb -> t & pk #~ 1 + fromMaybe 0 (tb ^? primaryMap.traverseMax.asIndex)@@ -267,6 +267,17 @@   at k f (Table m)  = Table <$> primaryMap (at k f) m   {-# INLINE at #-} +anon :: APrism' a () -> Iso' (Maybe a) a+anon p = iso (fromMaybe def) go where+  def                           = review (clonePrism p) ()+  go b | has (clonePrism p) b   = Nothing+       | otherwise              = Just b+{-# INLINE anon #-}++nil :: Prism' [a] ()+nil = prism' (const []) (guard . P.null)+{-# INLINE nil #-}+ deleteCollisions :: Table t -> [t] -> Table t deleteCollisions EmptyTable _ = EmptyTable deleteCollisions (Table tab) ts = Table $ runIdentity $ forTab tab $ \k i -> Identity $ case i of@@ -275,17 +286,17 @@   CandidateIntMap idx     -> CandidateIntMap          $ F.foldl' (flip (IM.delete . fetch k)) idx ts   CandidateHashMap idx    -> CandidateHashMap         $ F.foldl' (flip (HM.delete . fetch k)) idx ts   SupplementalMap idx     -> SupplementalMap $ M.foldlWithKey' ?? idx ?? M.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)   SupplementalIntMap idx  -> SupplementalIntMap $ IM.foldlWithKey' ?? idx ?? IM.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)   SupplementalHashMap idx -> SupplementalHashMap $ HM.foldlWithKey' ?? idx ?? HM.fromListWith (++) [ (fetch k t, [t]) | t <- ts ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)   InvertedMap idx         -> InvertedMap     $ M.foldlWithKey' ?? idx ?? M.fromListWith (++) [ (f, [t]) | t <- ts, f <- S.toList $ fetch k t ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)   InvertedIntMap idx      -> InvertedIntMap  $ IM.foldlWithKey' ?? idx ?? IM.fromListWith (++) [ (f, [t]) | t <- ts, f <- IS.toList $ fetch k t ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)   InvertedHashMap idx     -> InvertedHashMap $ HM.foldlWithKey' ?? idx ?? HM.fromListWith (++) [ (f, [t]) | t <- ts, f <- HS.toList $ fetch k t ] $ \m ky ys ->-    m & at ky . anon [] P.null %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)+    m & at ky . anon nil %~ let pys = fetch primary <$> ys in filter (\e -> fetch primary e `P.notElem` pys)  {-# INLINE deleteCollisions #-} @@ -372,12 +383,12 @@       CandidateMap idx        -> CandidateMap             $ idx & at (fetch k t) ?~ t       CandidateIntMap idx     -> CandidateIntMap          $ idx & at (fetch k t) ?~ t       CandidateHashMap idx    -> CandidateHashMap         $ idx & at (fetch k t) ?~ t-      SupplementalMap idx     -> SupplementalMap          $ idx & at (fetch k t) . anon [] P.null %~ (t:)-      SupplementalIntMap idx  -> SupplementalIntMap       $ idx & at (fetch k t) . anon [] P.null %~ (t:)-      SupplementalHashMap idx -> SupplementalHashMap      $ idx & at (fetch k t) . anon [] P.null %~ (t:)-      InvertedMap idx         -> InvertedMap              $ idx & flip (F.foldr $ \ik -> at ik . anon [] P.null %~ (t:)) (fetch k t)-      InvertedIntMap idx      -> InvertedIntMap           $ idx & flip (IS.foldr $ \ik -> at ik . anon [] P.null %~ (t:)) (fetch k t)-      InvertedHashMap idx     -> InvertedHashMap          $ idx & flip (F.foldr $ \ik -> at ik . anon [] P.null %~ (t:)) (fetch k t)+      SupplementalMap idx     -> SupplementalMap          $ idx & at (fetch k t) . anon nil %~ (t:)+      SupplementalIntMap idx  -> SupplementalIntMap       $ idx & at (fetch k t) . anon nil %~ (t:)+      SupplementalHashMap idx -> SupplementalHashMap      $ idx & at (fetch k t) . anon nil %~ (t:)+      InvertedMap idx         -> InvertedMap              $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+      InvertedIntMap idx      -> InvertedIntMap           $ idx & flip (IS.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)+      InvertedHashMap idx     -> InvertedHashMap          $ idx & flip (F.foldr $ \ik -> at ik . anon nil %~ (t:)) (fetch k t)   {-# INLINE go #-} {-# INLINE insert #-}
tables.cabal view
@@ -1,6 +1,6 @@ name:          tables category:      Data, Lenses-version:       0.3+version:       0.3.1 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE