fixfile 0.2.0.0 → 0.3.0.0

raw patch · 7 files changed

+259/−29 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• fixfile.cabal +1/−1
• src/Data/FixFile.hs +16/−3
• src/Data/FixFile/BTree.hs +26/−1
• src/Data/FixFile/Fixed.hs +61/−0
• src/Data/FixFile/Set.hs +10/−1
• src/Data/FixFile/Tree23.hs +108/−11
• src/Data/FixFile/Trie.hs +37/−12

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                   fixfile-version:                0.2.0.0+version:                0.3.0.0 synopsis:               File-backed recursive data structures. homepage:               https://github.com/revnull/fixfile license:                LGPL-3

@@ -43,6 +43,14 @@                      ,ParaAlg                      ,para                      ,iso+                     -- * Fixed Typeclasses+                     ,FixedAlg(..)+                     ,FixedSub(..)+                     ,FixedFunctor(..)+                     ,fmapF'+                     ,FixedFoldable(..)+                     ,FixedTraversable(..)+                     ,traverseF'                      -- * Root Data                      ,Fixable                      ,FixTraverse(..)@@ -57,6 +65,7 @@                      ,openFixFile                      ,openFixFileHandle                      ,closeFixFile+                     ,fixFilePath                      ,vacuum                      -- * Transactions                      ,Transaction@@ -226,7 +235,7 @@  {- |     'FixTraverse' is a class based on 'Traverse' but taking an argument of kind-    @(* -> *) -> *)@ instead of @*@.+    @((* -> *) -> *)@ instead of @*@. -} class FixTraverse (t :: ((* -> *) -> *) -> *) where     -- | Given a function that maps from @a@ to @b@ over @'Fixable' g@ in the@@ -344,6 +353,10 @@ -} data FixFile r = FixFile FilePath (MVar (FFH, r Ptr)) (MVar ()) +-- | Get the 'FilePath' of a 'FixFile'.+fixFilePath :: FixFile r -> FilePath+fixFilePath (FixFile p _ _) = p+ acquireWriteLock :: FixFile f -> IO () acquireWriteLock (FixFile _ _ wl) = do     void $ takeMVar wl@@ -376,7 +389,7 @@ -} createFixFile :: Root r => r Fix -> FilePath -> IO (FixFile r) createFixFile initial path =-    openFile path ReadWriteMode >>= createFixFileHandle initial path+    openBinaryFile path ReadWriteMode >>= createFixFileHandle initial path  {- |     Create a 'FixFile', using @'Fix' f@ as the initial structure to store@@ -402,7 +415,7 @@ -} openFixFile :: Binary (r Ptr) => FilePath -> IO (FixFile r) openFixFile path =-    openFile path ReadWriteMode >>= openFixFileHandle path+    openBinaryFile path ReadWriteMode >>= openFixFileHandle path  {- |     Open a 'FixFile' from the file described by 'FilePath' and using the

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric, DeriveFunctor, DeriveFoldable, DeriveTraversable,-    DeriveDataTypeable, DataKinds, KindSignatures #-}+    DeriveDataTypeable, DataKinds, KindSignatures, TypeFamilies,+    TupleSections #-}  {- |     Module      :  Data.FixFile.BTree@@ -319,4 +320,28 @@ -- | Turn a list of key value tuples into a 'Fixed' @('BTree' k v)@. fromListBTree :: (KnownNat n, Ord k, Fixed g) => [(k,v)] -> g (BTree n k v) fromListBTree = foldr (uncurry insertBTree) empty++instance FixedAlg (BTree n k v) where+    type Alg (BTree n k v) = v++instance FixedSub (BTree n k v) where+    type Sub (BTree n k v) v v' = BTree n k v'++instance FixedFunctor (BTree n k v) where+    fmapF f = cata phi where+        phi Empty = empty+        phi (Value v) = value (f v)+        phi (Node c vec) = node c vec++instance FixedFoldable (BTree n k v) where+    foldMapF f = cata phi where+        phi Empty = mempty+        phi (Value v) = f v+        phi (Node _ vec) = foldMap snd vec++instance FixedTraversable (BTree n k v) where+    traverseF f = cata phi where+        phi Empty = pure empty+        phi (Value v) = value <$> f v+        phi (Node c vec) = node c <$> traverse (\(w, a) -> (w,) <$> a) vec  

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies #-}  {- |     Module      :  Data.FixFile.Fixed@@ -23,6 +24,13 @@                            ,ParaAlg                            ,para                            ,iso+                           ,FixedAlg(..)+                           ,FixedSub(..)+                           ,FixedFunctor(..)+                           ,fmapF'+                           ,FixedFoldable(..)+                           ,FixedTraversable(..)+                           ,traverseF'                            ) where  {-|@@ -94,4 +102,57 @@ -} iso :: (Functor f, Fixed g, Fixed h) => g f -> h f iso = cata inf++{-|+    'FixedAlg' is a typeclass for describing the relationship between a+    'Functor' that is used with a 'Fixed' combinator and an algebraic datatype+    in that 'Functor' other than the one used for fixed-point recursion.+-}+class FixedAlg (f :: * -> *) where+    type Alg f :: *++{-|+    'FixedSub' is a typeclass for describing the relationship between a+    'FixedAlg' 'Functor' @f@ and that same 'Functor' with @Alg f@ switched+    from @v@ to @v'@.+-}+class FixedAlg f => FixedSub f where+    type Sub f v v' :: * -> *++{-|+    'FixedFunctor' is a typeclass for describing mapping behavior for datatypes+    used with 'Fixed' combinators.+-}+class FixedSub f => FixedFunctor f where+    -- | Map over a 'Fixed' recursive 'FixedSub' @f@.+    fmapF :: (Fixed g, Fixed g', a ~ Alg f) =>+        (a -> b) -> g f -> g' (Sub f a b)++-- | 'fmapF', but using a single instance of 'Fixed'.+fmapF' :: (FixedFunctor f, Fixed g, a ~ Alg f) =>+    (a -> b) -> g f -> g (Sub f a b)+fmapF' = fmapF++{-|+    'FixedFoldable' is a typeclass for describing folds over datatypes with+    'Fixed' combinators.+-}+class FixedAlg f => FixedFoldable f where+    -- | Fold over a 'Fixed' recursive 'FixedAlg' @f@.+    foldMapF :: (Fixed g, Monoid m, a ~ Alg f) => (a -> m) -> g f -> m++{-|+    'FixedTraversable' is a typeclass for describing traversals over datatypes+    with 'Fixed' combinators.+-}+class FixedSub f => FixedTraversable f where+    -- | Traverse over a 'Fixed' recursive 'FixedSub' @f@ in the 'Applicative'+    -- @h@.+    traverseF :: (Fixed g, Fixed g', Applicative h, a ~ Alg f) =>+        (a -> h b) -> g f -> h (g' (Sub f a b))++-- | 'traverseF', but using a single instance of 'Fixed'.+traverseF' :: (FixedTraversable f, Fixed g, Applicative h, a ~ Alg f) =>+    (a -> h b) -> g f -> h (g (Sub f a b))+traverseF' = traverseF 

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric, DeriveFunctor, DeriveFoldable, DeriveTraversable,-    DeriveDataTypeable #-}+    DeriveDataTypeable, TypeFamilies #-}  {- |     Module      :  Data.FixFile.Set@@ -34,6 +34,7 @@  import Data.Binary import Data.Dynamic+import Data.Monoid import GHC.Generics  import Data.FixFile@@ -115,4 +116,12 @@ -- | 'Transaction' version of 'toListSet'. toListSetT :: Binary i => Transaction (Ref (Set i)) s [i] toListSetT = lookupT toListSet++instance FixedAlg (Set i) where+    type Alg (Set i) = i++instance FixedFoldable (Set i) where+    foldMapF f = cata phi where+        phi Empty = mempty+        phi (Node l i r) = l <> f i <> r 

@@ -26,12 +26,16 @@                            ,lookupSet                            ,deleteSet                            ,partitionSet+                           ,minSet+                           ,maxSet                            ,toListSet                            ,fromListSet                            ,insertSetT                            ,lookupSetT                            ,deleteSetT                            ,partitionSetT+                           ,minSetT+                           ,maxSetT                            -- | * Map                            ,Map                            ,createMapFile@@ -41,7 +45,8 @@                            ,deleteMap                            ,partitionMap                            ,alterMap-                           ,mapMap+                           ,minMap+                           ,maxMap                            ,toListMap                            ,fromListMap                            ,insertMapT@@ -49,6 +54,8 @@                            ,deleteMapT                            ,partitionMapT                            ,alterMapT+                           ,minMapT+                           ,maxMapT                            ,keysMap                            ,valuesMap                            ,partitionTree23@@ -59,7 +66,9 @@ import Data.Dynamic import Data.Binary import Data.Maybe-import GHC.Generics+import Data.Monoid+import GHC.Generics (Generic)+import Unsafe.Coerce   import Data.FixFile @@ -153,6 +162,18 @@ partitionSet :: (Fixed g, Ord k, f ~ Tree23 (Set k)) => k -> g f -> (g f, g f) partitionSet k = partitionTree23 (SK k) +-- | return the minimum value+minSet :: (Fixed g, Ord k, f ~ Tree23 (Set k)) => g f -> Maybe k+minSet t = do+    (SK v, _) <- minTree23 t+    return v++-- | return the minimum value+maxSet :: (Fixed g, Ord k, f ~ Tree23 (Set k)) => g f -> Maybe k+maxSet t = do+    (SK v, _) <- maxTree23 t+    return v+ -- | Convert a set into a list of items. toListSet :: (Fixed g, Ord k, f ~ Tree23 (Set k)) => g f -> [k] toListSet = ($ []) . cata phi where@@ -195,6 +216,26 @@     Transaction (Ref f) s (Stored s f, Stored s f) partitionSetT k = lookupT (partitionSet k) +-- | 'FTransaction' version of 'minSet'.+minSetT :: (Binary k, Ord k, f ~ Tree23 (Set k)) =>+    Transaction (Ref f) s (Maybe k)+minSetT = lookupT minSet++-- | 'FTransaction' version of 'minSet'.+maxSetT :: (Binary k, Ord k, f ~ Tree23 (Set k)) =>+    Transaction (Ref f) s (Maybe k)+maxSetT = lookupT maxSet++instance FixedAlg (Tree23 (Set k)) where+    type Alg (Tree23 (Set k)) = k++instance FixedFoldable (Tree23 (Set k)) where+    foldMapF f = cata phi where+        phi Empty = mempty+        phi (Leaf (SK k) _) = f k+        phi (Two l _ r) = l <> r+        phi (Three l _ m _ r) = l <> m <> r+ -- | A 'Map' of keys 'k' to values 'v' represented as a Two-Three Tree. data Map k v @@ -253,16 +294,18 @@ valuesMap :: (Fixed g, Ord k, f ~ Tree23 (Map k v)) => g f -> [v] valuesMap = fmap snd . toListMap --- | Map a function over a map. Because of the way Tree23 is implemented, it is---   not possible to create a Functor instance to achieve this.-mapMap :: (Fixed g, Fixed h, Ord k) => (a -> b) -> g (Tree23 (Map k a)) ->-    h (Tree23 (Map k b))-mapMap f = cata phi where-    phi Empty = empty-    phi (Leaf (MK k) (MV a)) = leaf (MK k) (MV (f a))-    phi (Two l (MK k) r) = two l (MK k) r-    phi (Three l (MK k1) m (MK k2) r) = three l (MK k1) m (MK k2) r+-- | return the minimum key and value+minMap :: (Fixed g, Ord k, f ~ Tree23 (Map k v)) => g f -> Maybe (k, v)+minMap t = do+    (MK k, MV v) <- minTree23 t+    return (k, v) +-- | return the maximum key and value+maxMap :: (Fixed g, Ord k, f ~ Tree23 (Map k v)) => g f -> Maybe (k, v)+maxMap t = do+    (MK k, MV v) <- maxTree23 t+    return (k, v)+ -- | Create a 'FixFile' of a Map. createMapFile :: (Binary k, Typeable k, Binary v, Typeable v,         f ~ Tree23 (Map k v)) =>@@ -300,6 +343,16 @@     k -> (Maybe v -> Maybe v) -> Transaction (Ref f) s () alterMapT k f = alterT (alterMap k f) +-- | 'FTransaction' version of 'minMap'.+minMapT :: (Binary k, Binary v, Ord k, f ~ Tree23 (Map k v)) =>+    Transaction (Ref f) s (Maybe (k, v))+minMapT = lookupT minMap++-- | 'FTransaction' version of 'minMap'.+maxMapT :: (Binary k, Binary v, Ord k, f ~ Tree23 (Map k v)) =>+    Transaction (Ref f) s (Maybe (k, v))+maxMapT = lookupT maxMap+ -- lookup the value (if it exists) from a Fixed Tree23 for a given key. lookupTree23 :: (Fixed g, Ord (TreeKey d)) => TreeKey d ->     g (Tree23 d) -> Maybe (TreeValue d)@@ -514,4 +567,48 @@             Split2 (lbal, lv) (rbal, rv) ->                 Split2 (lbal -1, lv) (merge rbal rv k2 0 (two mn k2 rn))             _ -> error "Malformed Tree23"+++minTree23 :: Fixed g => g (Tree23 d) -> Maybe (TreeKey d, TreeValue d)+minTree23 = cata phi where+    phi Empty = Nothing+    phi (Leaf k v) = Just (k, v)+    phi (Two l _ _) = l+    phi (Three l _ _ _ _) = l++maxTree23 :: Fixed g => g (Tree23 d) -> Maybe (TreeKey d, TreeValue d)+maxTree23 = cata phi where+    phi Empty = Nothing+    phi (Leaf k v) = Just (k, v)+    phi (Two _ _ r) = r+    phi (Three _ _ _ _ r) = r ++instance FixedAlg (Tree23 (Map k v)) where+    type Alg (Tree23 (Map k v)) = v++instance FixedSub (Tree23 (Map k v)) where+    type Sub (Tree23 (Map k v)) v v' = Tree23 (Map k v')++instance FixedFunctor (Tree23 (Map k v)) where+    fmapF f = cata phi where+        phi Empty = empty+        phi (Leaf k (MV v)) = leaf (unsafeCoerce k) (MV (f v))+        phi (Two l k r) = two l (unsafeCoerce k) r+        phi (Three l k1 m k2 r) =+            three l (unsafeCoerce k1) m (unsafeCoerce k2) r++instance FixedFoldable (Tree23 (Map k v)) where+    foldMapF f = cata phi where+        phi Empty = mempty+        phi (Leaf _ (MV v)) = f v+        phi (Two l _ r) = l <> r+        phi (Three l _ m _ r) = l <> m <> r++instance FixedTraversable (Tree23 (Map k v)) where+    traverseF f = cata phi where+        phi Empty = pure empty+        phi (Leaf k (MV v)) = (leaf (unsafeCoerce k) . MV) <$> f v+        phi (Two l k r) = two <$> l <*> pure (unsafeCoerce k) <*> r+        phi (Three l k1 m k2 r) = three <$> l <*> pure (unsafeCoerce k1) <*>+            m <*> pure (unsafeCoerce k2) <*> r 

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric, DeriveFunctor, DeriveFoldable, DeriveTraversable,-    TypeFamilies, DeriveDataTypeable #-}+    TypeFamilies, DeriveDataTypeable, TupleSections #-}  {- |     Module      :  Data.FixFile.Trie@@ -25,7 +25,6 @@                          ,deleteTrieT                          ,iterateTrie                          ,iterateTrieT-                         ,trieMap                          ) where  import Prelude hiding (tail)@@ -38,6 +37,7 @@ import Data.Dynamic import qualified Data.Map as M import Data.Maybe+import Data.Monoid import GHC.Generics  import Data.FixFile@@ -336,14 +336,39 @@     Transaction (Ref (Trie v)) s [(BS.ByteString, v)] iterateTrieT k = lookupT (iterateTrie k) --- | Map a function over a 'Fixed' 'Trie'. Because of the data types used,---   this can't be implemented as a 'Functor'.-trieMap :: (Fixed h, Fixed i) => (v -> v') -> h (Trie v) -> i (Trie v')-trieMap f = cata phi where-    phi (Value v) = value (f v)-    phi (Tail v) = tail v-    phi (String v b t) = string v b t-    phi (Small v ts) = small v ts-    phi (Big v ts) = big v ts-    phi (Mutable v ts) = mut v ts+instance FixedAlg (Trie v) where+    type Alg (Trie v) = v++instance FixedSub (Trie v) where+    type Sub (Trie v) v v' = Trie v'++instance FixedFunctor (Trie v) where+    fmapF f = cata phi where+        phi (Value v) = value (f v)+        phi (Tail v) = tail v+        phi (String v b t) = string v b t+        phi (Small v ts) = small v ts+        phi (Big v ts) = big v ts+        phi (Mutable v ts) = mut v ts++instance FixedFoldable (Trie v) where+    foldMapF f = maybe mempty id . cata phi where+        phi (Value v) = Just (f v)+        phi (Tail v) = join v+        phi (String v _ t) = join v <> t+        phi (Small v l) = join v <> mconcat (snd <$> l)+        phi (Big v a) = join v <> mconcat (join <$> elems a)+        phi (Mutable v m) = join v <> foldMap id m++instance FixedTraversable (Trie v) where+    traverseF f = cata phi where+        mapply Nothing = pure Nothing+        mapply (Just v) = Just <$> v+        phi (Value v) = value <$> f v+        phi (Tail v) = tail <$> mapply v+        phi (String v b a) = string <$> mapply v <*> pure b <*> a+        phi (Small v l) = small <$> mapply v <*>+            traverse (\(w, a) -> (w,) <$> a) l+        phi (Big v a) = big <$> mapply v <*> traverse mapply a+        phi (Mutable v m) = mut <$> mapply v <*> traverse id m