Split to library and executable parts

1 files changed, 0 insertions, 156 deletions

diff --git a/src/Storage/List.hs b/src/Storage/List.hs
deleted file mode 100644
index 2bef401..0000000
--- a/src/Storage/List.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-module Storage.List (
-    StoredList,
-    emptySList, fromSList, storedFromSList,
-    slistAdd, slistAddS,
-    -- TODO slistInsert, slistInsertS,
-    slistRemove, slistReplace, slistReplaceS,
-    -- TODO mapFromSList, updateOld,
-
-    -- TODO StoreUpdate(..),
-    -- TODO withStoredListItem, withStoredListItemS,
-) where
-
-import Control.Monad.Reader
-
-import Data.List
-import Data.Maybe
-import qualified Data.Set as S
-
-import Storage
-import Storage.Internal
-import Storage.Merge
-
-data List a = ListNil
-            | ListItem { listPrev :: [StoredList a]
-                       , listItem :: Maybe (Stored a)
-                       , listRemove :: Maybe (Stored (List a))
-                       }
-
-type StoredList a = Stored (List a)
-
-instance Storable a => Storable (List a) where
-    store' ListNil = storeZero
-    store' x@ListItem {} = storeRec $ do
-        mapM_ (storeRef "PREV") $ listPrev x
-        mapM_ (storeRef "item") $ listItem x
-        mapM_ (storeRef "remove") $ listRemove x
-
-    load' = asks snd >>= \case
-        ZeroObject -> return ListNil
-        _ -> loadRec $ ListItem <$> loadRefs "PREV"
-                                <*> loadMbRef "item"
-                                <*> loadMbRef "remove"
-
-instance Storable a => ZeroStorable (List a) where
-    fromZero _ = ListNil
-
-
-emptySList :: Storable a => Storage -> IO (StoredList a)
-emptySList st = wrappedStore st ListNil
-
-groupsFromSLists :: forall a. Storable a => StoredList a -> [[Stored a]]
-groupsFromSLists = helperSelect S.empty . (:[])
-  where
-    helperSelect :: S.Set (StoredList a) -> [StoredList a] -> [[Stored a]]
-    helperSelect rs xxs | x:xs <- sort $ filterRemoved rs xxs = helper rs x xs
-                        | otherwise = []
-
-    helper :: S.Set (StoredList a) -> StoredList a -> [StoredList a] -> [[Stored a]]
-    helper rs x xs
-        | ListNil <- fromStored x
-        = []
-
-        | Just rm <- listRemove (fromStored x)
-        , ans <- ancestors [x]
-        , (other, collision) <- partition (S.null . S.intersection ans . ancestors . (:[])) xs
-        , cont <- helperSelect (rs `S.union` ancestors [rm]) $ concatMap (listPrev . fromStored) (x : collision) ++ other
-        = case catMaybes $ map (listItem . fromStored) (x : collision) of
-               [] -> cont
-               xis -> xis : cont
-
-        | otherwise = case listItem (fromStored x) of
-                           Nothing -> helperSelect rs $ listPrev (fromStored x) ++ xs
-                           Just xi -> [xi] : (helperSelect rs $ listPrev (fromStored x) ++ xs)
-
-    filterRemoved :: S.Set (StoredList a) -> [StoredList a] -> [StoredList a]
-    filterRemoved rs = filter (S.null . S.intersection rs . ancestors . (:[]))
-
-fromSList :: Mergeable a => StoredList (Component a) -> [a]
-fromSList = map merge . groupsFromSLists
-
-storedFromSList :: (Mergeable a, Storable a) => StoredList (Component a) -> IO [Stored a]
-storedFromSList = mapM storeMerge . groupsFromSLists
-
-slistAdd :: Storable a => a -> StoredList a -> IO (StoredList a)
-slistAdd x prev@(Stored (Ref st _) _) = do
-    sx <- wrappedStore st x
-    slistAddS sx prev
-
-slistAddS :: Storable a => Stored a -> StoredList a -> IO (StoredList a)
-slistAddS sx prev@(Stored (Ref st _) _) = wrappedStore st (ListItem [prev] (Just sx) Nothing)
-
-{- TODO
-slistInsert :: Storable a => Stored a -> a -> StoredList a -> IO (StoredList a)
-slistInsert after x prev@(Stored (Ref st _) _) = do
-    sx <- wrappedStore st x
-    slistInsertS after sx prev
-
-slistInsertS :: Storable a => Stored a -> Stored a -> StoredList a -> IO (StoredList a)
-slistInsertS after sx prev@(Stored (Ref st _) _) = wrappedStore st $ ListItem Nothing (findSListRef after prev) (Just sx) prev
--}
-
-slistRemove :: Storable a => Stored a -> StoredList a -> IO (StoredList a)
-slistRemove rm prev@(Stored (Ref st _) _) = wrappedStore st $ ListItem [prev] Nothing (findSListRef rm prev)
-
-slistReplace :: Storable a => Stored a -> a -> StoredList a -> IO (StoredList a)
-slistReplace rm x prev@(Stored (Ref st _) _) = do
-    sx <- wrappedStore st x
-    slistReplaceS rm sx prev
-
-slistReplaceS :: Storable a => Stored a -> Stored a -> StoredList a -> IO (StoredList a)
-slistReplaceS rm sx prev@(Stored (Ref st _) _) = wrappedStore st $ ListItem [prev] (Just sx) (findSListRef rm prev)
-
-findSListRef :: Stored a -> StoredList a -> Maybe (StoredList a)
-findSListRef _ (Stored _ ListNil) = Nothing
-findSListRef x cur | listItem (fromStored cur) == Just x = Just cur
-                   | otherwise                           = listToMaybe $ catMaybes $ map (findSListRef x) $ listPrev $ fromStored cur
-
-{- TODO
-mapFromSList :: Storable a => StoredList a -> Map RefDigest (Stored a)
-mapFromSList list = helper list M.empty
-    where helper :: Storable a => StoredList a -> Map RefDigest (Stored a) -> Map RefDigest (Stored a)
-          helper (Stored _ ListNil) cur = cur
-          helper (Stored _ (ListItem (Just rref) _ (Just x) rest)) cur =
-              let rxref = case load rref of
-                               ListItem _ _ (Just rx) _  -> sameType rx x $ storedRef rx
-                               _ -> error "mapFromSList: malformed list"
-               in helper rest $ case M.lookup (refDigest $ storedRef x) cur of
-                                     Nothing -> M.insert (refDigest rxref) x cur
-                                     Just x' -> M.insert (refDigest rxref) x' cur
-          helper (Stored _ (ListItem _ _ _ rest)) cur = helper rest cur
-          sameType :: a -> a -> b -> b
-          sameType _ _ x = x
-
-updateOld :: Map RefDigest (Stored a) -> Stored a -> Stored a
-updateOld m x = fromMaybe x $ M.lookup (refDigest $ storedRef x) m
-
-
-data StoreUpdate a = StoreKeep
-                   | StoreReplace a
-                   | StoreRemove
-
-withStoredListItem :: (Storable a) => (a -> Bool) -> StoredList a -> (a -> IO (StoreUpdate a)) -> IO (StoredList a)
-withStoredListItem p list f = withStoredListItemS (p . fromStored) list (suMap (wrappedStore $ storedStorage list) <=< f . fromStored)
-    where suMap :: Monad m => (a -> m b) -> StoreUpdate a -> m (StoreUpdate b)
-          suMap _ StoreKeep = return StoreKeep
-          suMap g (StoreReplace x) = return . StoreReplace =<< g x
-          suMap _ StoreRemove = return StoreRemove
-
-withStoredListItemS :: (Storable a) => (Stored a -> Bool) -> StoredList a -> (Stored a -> IO (StoreUpdate (Stored a))) -> IO (StoredList a)
-withStoredListItemS p list f = do
-    case find p $ storedFromSList list of
-         Just sx -> f sx >>= \case StoreKeep -> return list
-                                   StoreReplace nx -> slistReplaceS sx nx list
-                                   StoreRemove -> slistRemove sx list
-         Nothing -> return list
--}