apart (empty) → 0.1.0
raw patch · 19 files changed
+720/−0 lines, 19 filesdep +apartdep +basedep +comonadsetup-changed
Dependencies added: apart, base, comonad, contravariant, free, hedgehog, lens, semigroupoids
Files
- Data/Apart.hs +23/−0
- Data/Apart/Apart.hs +39/−0
- Data/Apart/Combinators.hs +37/−0
- Data/Apart/Shape.hs +39/−0
- Data/Apart/Structures/Graph.hs +46/−0
- Data/Apart/Structures/Stack.hs +17/−0
- Data/Apart/Structures/Stream.hs +13/−0
- Data/Apart/Structures/Tree/Binary.hs +115/−0
- Data/Apart/Structures/Tree/Binary/AVL.hs +68/−0
- Data/Apart/Structures/Tree/Binary/Splay.hs +52/−0
- Data/Apart/Structures/Tree/Prefix.hs +46/−0
- Data/Apart/Structures/Tree/Rose.hs +9/−0
- Data/Apart/Structures/Tree/T23.hs +7/−0
- Data/Apart/Structures/Tree/T234.hs +8/−0
- Example/Main.hs +27/−0
- LICENSE +29/−0
- Setup.hs +2/−0
- Test/Apart.hs +29/−0
- apart.cabal +114/−0
+ Data/Apart.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Apart+-- Copyright : (C) 2018 Murat Kasimov+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Murat Kasimov <iokasimov.m@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Get all your structure and rip it apart.+--+-- The main idea: if you can describe your data structure via Cofree, with apart you can serialize, persistent or hash a segment of your structure!+--+-- A simple introduction to this library can be found here: https://iokasimov.github.io/posts/2018/05/cofree-will-tear-us-apart+----------------------------------------------------------------------------++module Data.Apart+ ( module Data.Apart.Apart+ , module Data.Apart.Combinators+ ) where++import Data.Apart.Apart+import Data.Apart.Combinators
+ Data/Apart/Apart.hs view
@@ -0,0 +1,39 @@+module Data.Apart.Apart (Apart (..), Shape (..), Segment (..), Scattered (..)) where++import Control.Comonad.Cofree (Cofree (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Kind (Type)++import Data.Apart.Shape (Shape (..))++-- | Structure with scattered segments.+data Apart t raw value = Apart+ { part :: (Cofree (Shape t raw) value) }++instance Functor t => Functor (Apart t raw) where+ fmap f (Apart structure) = Apart $ f <$> structure++instance Functor t => Bifunctor (Apart t) where+ bimap g f (Apart (x :< Ready values)) = Apart $+ f x :< Ready (part . bimap g f . Apart <$> values)+ bimap g f (Apart (x :< Converted raw)) = Apart $+ f x :< (Converted $ g raw)++instance Foldable t => Bifoldable (Apart t) where+ bifoldr g f acc (Apart (x :< Ready values)) = f x $+ foldr (\st a -> bifoldr g f a $ Apart st) acc values+ bifoldr g f acc (Apart (x :< Converted raw)) = f x $ g raw acc++instance Traversable t => Bitraversable (Apart t) where+ bitraverse g f (Apart (x :< Ready values)) = (<$>) Apart $ (:<) <$> f x <*>+ (Ready <$> traverse ((<$>) part . bitraverse g f . Apart) values)+ bitraverse g f (Apart (x :< Converted raw)) = (<$>) Apart $+ (:<) <$> f x <*> (Converted <$> g raw)++type family Segment (structure :: Type -> Type) (value :: Type) :: Type where+ Segment (Cofree t) value = t (Cofree t value)++type family Scattered (structure :: Type -> Type) (value :: Type) (raw :: Type) :: Type where+ Scattered (Cofree t) value raw = Apart t raw value
+ Data/Apart/Combinators.hs view
@@ -0,0 +1,37 @@+module Data.Apart.Combinators (Restorer, Materializer, recover, limit, fluent) where++import Control.Comonad.Cofree (Cofree (..))+import Control.Monad (join)++import Data.Apart.Apart (Apart (..), Shape (..), Scattered (..), Segment (..))++-- | Pull back segment of values to memory.+type Restorer g t raw value = (Traversable t, Applicative g) =>+ raw -> g (Segment (Cofree t) value)++-- | Put in-memory values to somewhere else.+type Materializer g t raw value = (Traversable t, Applicative g) =>+ Segment (Cofree t) value -> g raw++-- | Do nothing with in-memory part, pull back all values of structure to memory.+recover :: (Traversable t, Applicative g) => Restorer g t raw value+ -> Scattered (Cofree t) value raw -> g (Cofree t value)+recover convert (Apart (x :< Ready values)) = (:<) x <$>+ traverse (recover convert . Apart) values+recover convert (Apart (x :< Converted raw)) = (:<) x <$> convert raw++-- | Keep only a certain number of elements in memory, do something with the rest.+limit :: (Traversable t, Applicative g) => Int -> Materializer g t raw value+ -> Cofree t value -> g (Scattered (Cofree t) value raw)+limit ((>=) 0 -> True) convert (x :< rest) = error "Limit value should be greater than 0"+limit 1 convert (x :< rest) = (Apart . (:<) x . Converted) <$> convert rest+limit n convert (x :< rest) = (<$>) (Apart . (:<) x . Ready) $+ ((<$>) . (<$>)) part $ traverse (limit (n - 1) convert) rest++-- | Traverse over scattered structure, including with all restored segments.+fluent :: (Traversable t, Monad g) => (value -> g res) -> Restorer g t raw value+ -> (Scattered (Cofree t) value raw) -> g (Cofree t res)+fluent for_value for_raw (Apart (x :< Ready values)) = (:<) <$> for_value x+ <*> (traverse (fluent for_value for_raw . Apart) values)+fluent for_value for_raw (Apart (x :< Converted raw)) = join $+ traverse for_value <$> ((:<) x <$> for_raw raw)
+ Data/Apart/Shape.hs view
@@ -0,0 +1,39 @@+module Data.Apart.Shape (Shape (..)) where++import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Semigroup (Semigroup (..))++-- | Type that can tell you about aggregate state of your structure.+data Shape t raw value+ = Ready (t value) -- ^ Segment of values in memory+ | Converted raw -- ^ Segment of values somewhere else++instance (Show (t value), Show value, Show raw) => Show (Shape t raw value) where+ show (Ready values) = show values+ show (Converted raw) = "{" <> show raw <> "}"++instance Functor t => Functor (Shape t raw) where+ fmap f (Ready values) = Ready $ f <$> values+ fmap f (Converted raw) = Converted raw++instance Foldable t => Foldable (Shape t raw) where+ foldr f acc (Ready values) = foldr f acc values+ foldr f acc (Converted raw) = acc++instance Traversable t => Traversable (Shape t raw) where+ traverse f (Ready values) = Ready <$> traverse f values+ traverse _ (Converted raw) = pure $ Converted raw++instance Functor t => Bifunctor (Shape t) where+ bimap _ f (Ready values) = Ready $ f <$> values+ bimap g _ (Converted raw) = Converted $ g raw++instance Foldable t => Bifoldable (Shape t) where+ bifoldr _ f acc (Ready values) = foldr f acc values+ bifoldr g _ acc (Converted raw) = g raw acc++instance Traversable t => Bitraversable (Shape t) where+ bitraverse _ f (Ready values) = Ready <$> traverse f values+ bitraverse g _ (Converted raw) = Converted <$> g raw
+ Data/Apart/Structures/Graph.hs view
@@ -0,0 +1,46 @@+module Data.Apart.Structures.Graph (Graph, Edge (..), isolated, star, remove) where++import Control.Comonad.Cofree (Cofree (..), unwrap)+import Control.Comonad (Comonad (..))++import Data.Apart.Apart (Segment (..))++-- | Directed acyclic graph.+type Graph = Cofree Edge++data Edge a = Empty | Single a | Connect a | Overlay a deriving Show++instance Functor Edge where+ fmap f Empty = Empty+ fmap f (Single x) = Single $ f x+ fmap f (Connect x) = Connect $ f x+ fmap f (Overlay x) = Overlay $ f x++instance Foldable Edge where+ foldr f acc Empty = acc+ foldr f acc (Single x) = f x acc+ foldr f acc (Connect x) = f x acc+ foldr f acc (Overlay x) = f x acc++instance Traversable Edge where+ traverse f Empty = pure Empty+ traverse f (Single x) = Connect <$> f x+ traverse f (Connect x) = Connect <$> f x+ traverse f (Overlay x) = Overlay <$> f x++single, connect, overlay, empty :: Segment Graph a -> Segment Graph a+single = foldr (\x _ -> Single x) Empty+connect = foldr (\x _ -> Connect x) Empty+overlay = foldr (\x _ -> Overlay x) Empty+empty = const Empty++isolated :: Foldable t => t a -> Segment Graph a+isolated = foldr (\el -> Overlay . (:<) el) Empty++star :: Foldable t => a -> t a -> Graph a+star x structure = x :< connect (isolated structure)++-- | Remove vertex and all of its edges.+remove :: Eq a => a -> Cofree Edge a -> Edge (Cofree Edge a)+remove x graph@((==) x . extract -> True) = overlay $ unwrap graph+remove x graph@(y :< segment) = ((:<) y . overlay . remove x) <$> segment
+ Data/Apart/Structures/Stack.hs view
@@ -0,0 +1,17 @@+module Data.Apart.Structures.Stack (Stack, insert, foldaway) where++import Control.Comonad.Cofree (Cofree (..))++import Data.Apart.Apart (Segment (..))++-- | Or non-empty list.+type Stack = Cofree Maybe++insert :: a -> Stack a -> Stack a+insert x = (:<) x . Just++-- when I understand how to use partially applied+-- type families correctly, it can be rewritten+-- slightly as natural transformation+foldaway :: Foldable t => t a -> Segment Stack a+foldaway = foldr (\el -> Just . (:<) el) Nothing
+ Data/Apart/Structures/Stream.hs view
@@ -0,0 +1,13 @@+module Data.Apart.Structures.Stream (Stream, same) where++import Control.Comonad.Cofree (Cofree (..))+import Data.Functor.Identity (Identity (..))++-- | Infinite sequence.+type Stream = Cofree Identity++same :: a -> Stream a+same x = x :< Identity (same x)++iter :: (a -> a) -> a -> Stream a+iter f x = x :< Identity (iter f $ f x)
+ Data/Apart/Structures/Tree/Binary.hs view
@@ -0,0 +1,115 @@+module Data.Apart.Structures.Tree.Binary+ (Binary, Branches (..), ls, gt, singleton, insert, height, factor) where++import Control.Comonad.Cofree (Cofree (..))+import Data.Functor.Apply (Apply (..))+import Data.Functor.Alt (Alt (..))+import Data.Functor.Bind (Bind (..))+import Data.Semigroup (Semigroup (..))++import Data.Apart.Apart (Segment (..))++type Binary = Cofree Branches++data Branches a+ = End -- ^ No children+ | Less a -- ^ Left child+ | Greater a -- ^ Right child+ | Branches a a -- ^ Both+ deriving Show++instance Semigroup (Branches a) where+ End <> x = x+ Less x <> Less y = Less x+ Greater x <> Greater y = Greater x+ Less x <> Greater y = Branches x y+ Greater y <> Less x = Branches x y+ Branches x y <> _ = Branches x y+ _ <> End = End++instance Apply Branches where+ End <.> _ = End+ _ <.> End = End+ Less f <.> Less x = Less $ f x+ Less f <.> Greater x = Less $ f x+ Less f <.> Branches x y = Greater $ f y+ Greater f <.> Greater x = Greater $ f x+ Greater f <.> Less x = Greater $ f x+ Greater f <.> Branches x y = Greater $ f x+ Branches f g <.> Less x = Less $ f x+ Branches f g <.> Greater x = Greater $ g x+ Branches f g <.> Branches x y = Branches (f x) (g y)++instance Alt Branches where+ End <!> x = x+ x <!> End = x+ Less x <!> Greater y = Branches x y+ Less x <!> y = y+ Greater y <!> Less x = Branches x y+ Greater y <!> x = x+ Branches x y <!> _ = Branches x y++instance Bind Branches where+ End >>- f = End+ Less x >>- f = f x+ Greater x >>- f = f x+ Branches x y >>- f = f x <> f y++instance Functor Branches where+ fmap f End = End+ fmap f (Less l) = Less $ f l+ fmap f (Greater r) = Greater $ f r+ fmap f (Branches l r) = Branches (f l) (f r)++-- pre-order traversal only+instance Foldable Branches where+ foldr f acc End = acc+ foldr f acc (Less l) = f l acc+ foldr f acc (Greater g) = f g acc+ foldr f acc (Branches l g) = f l $ f g acc++instance Traversable Branches where+ traverse f End = pure End+ traverse f (Less x) = Less <$> f x+ traverse f (Greater x) = Greater <$> f x+ traverse f (Branches l g) = Branches <$> f l <*> f g++-- | Get @x@ from @Branches x y@ or from @Less x@.+ls :: Binary a -> Segment Binary a+ls (_ :< Less x) = Less x+ls (_ :< Branches x _) = Less x+ls (_ :< _) = End++-- | Get @y@ from @Branches x y@ or from @Greater y@.+gt :: Binary a -> Segment Binary a+gt (_ :< Greater x) = Greater x+gt (_ :< Branches _ x) = Greater x+gt (_ :< _) = End++singleton :: a -> Binary a+singleton x = x :< End++insert :: Ord a => Binary a -> a -> Binary a+insert (y :< End) x@((>) y -> True) = y :< Less (x :< End)+insert (y :< End) x@((<) y -> True) = y :< Greater (x :< End)+insert (y :< Less lt) x@((>) y -> True) = y :< Less (insert lt x)+insert (y :< Less lt) x@((<) y -> True) = y :< Branches lt (x :< End)+insert (y :< Greater gt) x@((>) y -> True) = y :< Branches (x :< End) gt+insert (y :< Greater gt) x@((<) y -> True) = y :< Greater (insert gt x)+insert (y :< Branches lt gt) x@((>) y -> True) = y :< Branches (insert lt x) gt+insert (y :< Branches lt gt) x@((<) y -> True) = y :< Branches lt (insert gt x)+insert binary x = binary++-- | The way to the most remote branch.+height :: Binary a -> Int+height (a :< End) = 1+height (a :< Less l) = 1 + height l+height (a :< Greater g) = 1 + height g+height (a :< Branches l g) = 1 + max (height l) (height g)++-- | Balance factor for root node.+factor :: Binary a -> Int+factor (a :< End) = 1+factor (a :< Less l) = (1 + factor l) - 1+factor (a :< Greater g) = (1 + factor g) - 1+factor (a :< Branches l g) = (height l) - (height g)
+ Data/Apart/Structures/Tree/Binary/AVL.hs view
@@ -0,0 +1,68 @@+module Data.Apart.Structures.Tree.Binary.AVL (insert) where++import Control.Arrow ((&&&))+import Data.Functor.Contravariant (Predicate (..))+import Data.Functor.Contravariant.Divisible (Divisible (..))+import Data.Functor.Bind (Bind (..))++import Data.Apart.Apart (Segment (..))+import Data.Apart.Structures.Tree.Binary (Binary, Branches (..), ls, gt, height)+import qualified Data.Apart.Structures.Tree.Binary as Binary (insert)+import Data.Apart.Structures.Tree.Binary.Rotation (Rotate (..), rtt)++-- | Trying rebalance tree after each insert.+insert :: Ord a => a -> Binary a -> Segment Binary a+insert x tree = balancing $ Binary.insert tree x++balancing :: Binary a -> Segment Binary a+balancing t@(getPredicate simple_left -> True) = rtt L t+balancing t@(getPredicate simple_right -> True) = rtt R t+balancing t@(getPredicate double_left -> True) = rtt RL t+balancing t@(getPredicate double_right -> True) = rtt LR t++subheight :: Segment Binary a -> Int+subheight = foldr (\t _ -> height t) 0++simple_left :: Predicate (Binary a)+simple_left = divide (id &&& id)+ gl_LT_or_EQ_gg g_height_diff_2_l++simple_right :: Predicate (Binary a)+simple_right = divide (id &&& id)+ lg_GT_or_EQ_ll l_height_diff_2_g++double_left :: Predicate (Binary a)+double_left = divide (id &&& id)+ gl_LT_or_EQ_gg gl_GT_gg++double_right :: Predicate (Binary a)+double_right = divide (id &&& id)+ lg_GT_or_EQ_ll lg_GT_ll++gl_LT_or_EQ_gg :: Predicate (Binary a)+gl_LT_or_EQ_gg = Predicate $ \t -> (<=)+ (subheight $ gt t >>- ls)+ (subheight $ gt t >>- gt)++lg_GT_or_EQ_ll :: Predicate (Binary a)+lg_GT_or_EQ_ll = Predicate $ \t -> (>=)+ (subheight $ ls t >>- gt)+ (subheight $ ls t >>- ls)++gl_GT_gg :: Predicate (Binary a)+gl_GT_gg = Predicate $ \t -> (>)+ (subheight $ gt t >>- ls)+ (subheight $ gt t >>- gt)++lg_GT_ll :: Predicate (Binary a)+lg_GT_ll = Predicate $ \t -> (>)+ (subheight $ ls t >>- gt)+ (subheight $ ls t >>- ls)++g_height_diff_2_l :: Predicate (Binary a)+g_height_diff_2_l = Predicate $ \t -> (== 2) $ (-)+ (subheight $ gt t) (subheight $ ls t)++l_height_diff_2_g :: Predicate (Binary a)+l_height_diff_2_g = Predicate $ \t -> (== 2) $ (-)+ (subheight $ ls t) (subheight $ gt t)
+ Data/Apart/Structures/Tree/Binary/Splay.hs view
@@ -0,0 +1,52 @@+module Data.Apart.Structures.Tree.Binary.Splay (search, insert) where++import Control.Comonad (Comonad (..))+import Data.Foldable (find)+import Data.Functor.Bind (Bind (..))+import Data.Functor.Contravariant (Predicate (..))+import Data.Function ((&))++import Data.Apart.Apart (Segment (..))+import Data.Apart.Structures.Tree.Binary (Binary, Branches (..), ls, gt)+import qualified Data.Apart.Structures.Tree.Binary as Binary (insert)+import Data.Apart.Structures.Tree.Binary.Rotation (Rotate (..), rtt)++-- | Splay tree after each insert.+insert :: Ord a => a -> Binary a -> Segment Binary a+insert x t = splay x $ Binary.insert t x++-- | If needed element not in the root - it isn't found.+search :: Eq a => a -> Binary a -> Segment Binary a+search x t = maybe End (const $ splay x t) $ find (== x) t++left_zig :: Eq a => Predicate (a, Binary a)+left_zig = Predicate $ \ (x, t) -> gt t+ & foldr (\g _ -> extract g == x) False++right_zig :: Eq a => Predicate (a, Binary a)+right_zig = Predicate $ \ (x, t) -> ls t+ & foldr (\l _ -> extract l == x) False++left_zig_zig :: Eq a => Predicate (a, Binary a)+left_zig_zig = Predicate $ \ (x, t) -> gt t >>- gt+ & foldr (\gg _ -> extract gg == x) False++right_zig_zig :: Eq a => Predicate (a, Binary a)+right_zig_zig = Predicate $ \ (x, t) -> ls t >>- ls+ & foldr (\ll _ -> extract ll == x) False++left_zig_zag :: Eq a => Predicate (a, Binary a)+left_zig_zag = Predicate $ \ (x, t) -> gt t >>- ls+ & foldr (\gl _ -> extract gl == x) False++right_zig_zag :: Eq a => Predicate (a, Binary a)+right_zig_zag = Predicate $ \ (x, t) -> ls t >>- gt+ & foldr (\lg _ -> extract lg == x) False++splay :: Eq a => a -> Binary a -> Segment Binary a+splay x t@(getPredicate left_zig . (x,) -> True) = rtt L t+splay x t@(getPredicate right_zig . (x,) -> True) = rtt R t+splay x t@(getPredicate left_zig_zig . (x,) -> True) = rtt LL t+splay x t@(getPredicate right_zig_zig . (x,) -> True) = rtt RR t+splay x t@(getPredicate left_zig_zag . (x,) -> True) = rtt RL t+splay x t@(getPredicate right_zig_zag . (x,) -> True) = rtt LR t
+ Data/Apart/Structures/Tree/Prefix.hs view
@@ -0,0 +1,46 @@+module Data.Apart.Structures.Tree.Prefix (Prefix, Labeled (..), seek, insert) where++import Control.Applicative (Alternative (..))+import Control.Comonad (Comonad (..))+import Control.Comonad.Cofree (Cofree (..), unwrap)+import Control.Lens (Lens', (^.), (%~))+import Data.Maybe (isJust)+import Data.Function ((&))+import Data.Foldable (find)+import Data.Monoid (Monoid (..), (<>))++import Data.Apart.Structures.Stack (Stack)++type Prefix s t = Cofree (Labeled s t)++data Labeled s t a = Hop s (t a) deriving Show++symbol :: Lens' (Prefix s t a) s+symbol f (x :< Hop s ns) = (\new -> x :< Hop new ns) <$> f s++nodes :: Lens' (Prefix s t a) (t (Prefix s t a))+nodes f (x :< Hop s ns) = (\new -> x :< Hop s new) <$> f ns++instance Functor t => Functor (Labeled s t) where+ fmap f (Hop s as) = Hop s $ f <$> as++instance Foldable t => Foldable (Labeled s t) where+ foldr f acc (Hop s as) = foldr f acc as++instance Traversable t => Traversable (Labeled s t) where+ traverse f (Hop s as) = Hop s <$> traverse f as++seek :: (Functor t, Foldable t, Eq s) => Stack s -> Prefix s t v -> Maybe v+seek (s :< Just ss) prefix@((==) s . flip (^.) symbol -> True) =+ (<$>) extract $ find (isJust . seek ss) $ unwrap prefix+seek (s :< Nothing) prefix@((==) s . flip (^.) symbol -> True) = Just $ extract prefix+seek (s :< _) prefix@((==) s . flip (^.) symbol -> False) = Nothing++-- | You can insert value with @path + 1 symbol@ of existing @path@ in tree.+insert :: (Foldable t, Alternative t, Eq s) => Stack s -> v -> Prefix s t v -> Prefix s t v+insert (s :< _) x prefix@((==) s . flip (^.) symbol -> False) = prefix+insert (s :< Nothing) x prefix@((==) s . flip (^.) symbol -> True) = x :< unwrap prefix+insert (s :< Just ss@(s' :< Just _)) x prefix@((==) s . flip (^.) symbol -> True) =+ prefix & nodes %~ (<$>) (insert ss x)+insert (s :< Just ss@(s' :< Nothing)) x prefix@((==) s . flip (^.) symbol -> True) =+ prefix & nodes %~ (<|>) (pure $ x :< Hop s' empty)
+ Data/Apart/Structures/Tree/Rose.hs view
@@ -0,0 +1,9 @@+module Data.Apart.Structures.Tree.Rose (Rose, construct) where++import Control.Applicative (Alternative (..))+import Control.Comonad.Cofree (Cofree (..), coiter)++type Rose t = Cofree t++construct :: (Functor t, Alternative t) => a -> t a -> Rose t a+construct x structure = (:<) x $ (<$>) (coiter $ const empty) structure
+ Data/Apart/Structures/Tree/T23.hs view
@@ -0,0 +1,7 @@+module Data.Apart.Structures.Tree.T23 (T23, N23 (..)) where++import Control.Comonad.Cofree (Cofree (..))++data N23 a b = L2 a a | L3 a a a a | B2 b b | B3 a b b b++type T23 a = Cofree (N23 a) a
+ Data/Apart/Structures/Tree/T234.hs view
@@ -0,0 +1,8 @@+module Data.Apart.Structures.Tree.T234 (T234, N234 (..)) where++import Control.Comonad.Cofree (Cofree (..))++data N234 a b = L2 a a | L3 a a a a | L4 a a a a a a+ | B2 b b | B3 a b b b | B4 a a b b b b++type T234 a = Cofree (N234 a) a
+ Example/Main.hs view
@@ -0,0 +1,27 @@+import Control.Comonad.Cofree (Cofree (..))+import Data.Foldable (toList)++import Data.Apart (Apart (..), Shape (..), Scattered (..), Segment (..), limit, fluent, recover)+import Data.Apart.Structures.Stack (Stack)++-- part of data structure in some file+scattered :: Scattered Stack Int FilePath+scattered = Apart $ 1 :< Ready (Just $ 2 :< Ready (Just $ 3 :< Converted "Example/piece.txt"))++read_from_file :: FilePath -> IO (Segment Stack Int)+read_from_file fp = read @(Segment Stack Int) <$> readFile fp++-- the whole structure in memory+inmemory :: Stack Int+inmemory = 1 :< Just (2 :< Just (3 :< Just (4 :< Just (5 :< Nothing))))++save_to_file :: FilePath -> Segment Stack Int -> IO FilePath+save_to_file fp structure = writeFile fp (show structure) *> pure fp++main = do+ print "Splitting data structure based on limit, the rest should be putted in file"+ limit 4 (save_to_file "Example/backup.txt") inmemory >>= print . toList . part+ print "Recovering data structure, the rest of structure should be in file"+ recover read_from_file scattered >>= print . toList+ print "Traverse over structure with action, recover segments on the way"+ fluent print read_from_file scattered
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2018, Murat Kasimov+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* 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.++* Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Apart.hs view
@@ -0,0 +1,29 @@+module Main where++import System.IO (BufferMode(..), hSetBuffering, stdout, stderr)+import Hedgehog (Group (..), checkParallel)++import Test.Apart.Structures.Stack+import Test.Apart.Structures.Tree.Binary+import Test.Apart.Structures.Tree.Binary.AVL+import Test.Apart.Structures.Tree.Binary.Splay++main = do+ hSetBuffering stdout LineBuffering+ hSetBuffering stderr LineBuffering++ checkParallel $ Group "Stack structure" [+ ( "Same length with origin of foldaway"+ , same_length_with_origin_of_foldaway )]++ checkParallel $ Group "Binary tree structure" [+ ( "Any left left is less, any right is greater"+ , any_left_left_is_less_any_right_is_greater )]++ checkParallel $ Group "AVL tree structure" [+ ( "Balance factor is well"+ , balance_factor_is_well )]++ checkParallel $ Group "Splay tree structure" [+ ( "Found element should be lifted to root"+ , found_element_should_be_lifted_to_root )]
+ apart.cabal view
@@ -0,0 +1,114 @@+name: apart+version: 0.1.0+synopsis: Get all your structure and rip it apart.+homepage: https://github.com/iokasimov/tree+license: BSD3+license-file: LICENSE+author: Murat Kasimov+maintainer: Murat Kasimov <iokasimov.m@gmail.com>+copyright: Copyright (c) 2018 Murat Kasimov+category: Data, Control+build-type: Simple+cabal-version: >= 1.10++description: The main idea: if you can describe your data structure via Cofree, with apart you can serialize, persistent or hash a segment of your structure!++source-repository head+ type: git+ location: https://github.com/iokasimov/apart.git++library+ exposed-modules:+ Data.Apart,+ Data.Apart.Structures.Graph,+ Data.Apart.Structures.Stack,+ Data.Apart.Structures.Stream,+ Data.Apart.Structures.Tree.T23,+ Data.Apart.Structures.Tree.T234,+ Data.Apart.Structures.Tree.Rose,+ Data.Apart.Structures.Tree.Prefix,+ Data.Apart.Structures.Tree.Binary,+ Data.Apart.Structures.Tree.Binary.AVL,+ Data.Apart.Structures.Tree.Binary.Splay+ other-modules:+ Data.Apart.Apart,+ Data.Apart.Shape,+ Data.Apart.Combinators+ build-depends:+ base == 4.*+ , free+ , comonad+ , lens+ , contravariant+ , hedgehog+ , semigroupoids+ default-language: Haskell2010+ ghc-options: -fno-warn-tabs+ default-extensions:+ ExistentialQuantification,+ LambdaCase+ TypeApplications,+ DataKinds,+ KindSignatures,+ RankNTypes,+ TypeInType,+ TypeFamilies,+ TypeOperators,+ ViewPatterns,+ PatternSynonyms,+ TupleSections++executable example+ main-is: Example/Main.hs+ build-depends:+ base == 4.*+ , free+ , comonad+ , lens+ , contravariant+ , hedgehog+ , semigroupoids+ , apart+ default-language: Haskell2010+ ghc-options: -fno-warn-tabs+ default-extensions:+ ExistentialQuantification,+ TypeApplications,+ DataKinds,+ KindSignatures,+ RankNTypes,+ TypeInType,+ TypeFamilies,+ TypeOperators,+ ViewPatterns,+ PatternSynonyms,+ TupleSections++test-suite test+ type: exitcode-stdio-1.0+ main-is: Test/Apart.hs+ build-depends:+ base == 4.*+ , free+ , comonad+ , lens+ , contravariant+ , hedgehog+ , semigroupoids+ , apart+ default-language: Haskell2010+ default-extensions:+ OverloadedStrings,+ ExistentialQuantification,+ LambdaCase+ TypeApplications,+ DataKinds,+ KindSignatures,+ RankNTypes,+ TypeInType,+ TypeFamilies,+ TypeOperators,+ ViewPatterns,+ PatternSynonyms,+ TupleSections+ ghc-options: -fno-warn-tabs