diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-11-15 22:17:48 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-11-17 22:15:45 +0100 |
commit | a5f8c25eb31aa9c6997cba1431a44beda1a30a94 (patch) | |
tree | 0ad10767ef7e17d7f12c26649122b4d0c5335340 | |
parent | c6d2fb81847407ba3a0ce3c5c9e890cc4de87cf2 (diff) |
-rw-r--r-- | src/Erebos/Object/Internal.hs | 72 |
1 files changed, 0 insertions, 72 deletions
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs index 03ee83c..f08e734 100644 --- a/src/Erebos/Object/Internal.hs +++ b/src/Erebos/Object/Internal.hs @@ -45,12 +45,6 @@ module Erebos.Object.Internal ( wrappedStore, wrappedLoad, copyStored, unsafeMapStored, - - StoreInfo(..), makeStoreInfo, - - StoredHistory, - fromHistory, fromHistoryAt, storedFromHistory, storedHistoryList, - beginHistory, modifyHistory, ) where import Control.Applicative @@ -778,72 +772,6 @@ unsafeMapStored :: (a -> b) -> Stored a -> Stored b unsafeMapStored f (Stored ref x) = Stored ref (f x) -data StoreInfo = StoreInfo - { infoDate :: ZonedTime - , infoNote :: Maybe Text - } - deriving (Show) - -makeStoreInfo :: IO StoreInfo -makeStoreInfo = StoreInfo - <$> getZonedTime - <*> pure Nothing - -storeInfoRec :: StoreInfo -> StoreRec c -storeInfoRec info = do - storeDate "date" $ infoDate info - storeMbText "note" $ infoNote info - -loadInfoRec :: LoadRec StoreInfo -loadInfoRec = StoreInfo - <$> loadDate "date" - <*> loadMbText "note" - - -data History a = History StoreInfo (Stored a) (Maybe (StoredHistory a)) - deriving (Show) - -type StoredHistory a = Stored (History a) - -instance Storable a => Storable (History a) where - store' (History si x prev) = storeRec $ do - storeInfoRec si - storeMbRef "prev" prev - storeRef "item" x - - load' = loadRec $ History - <$> loadInfoRec - <*> loadRef "item" - <*> loadMbRef "prev" - -fromHistory :: StoredHistory a -> a -fromHistory = fromStored . storedFromHistory - -fromHistoryAt :: ZonedTime -> StoredHistory a -> Maybe a -fromHistoryAt zat = fmap (fromStored . snd) . listToMaybe . dropWhile ((at<) . zonedTimeToUTC . fst) . storedHistoryTimedList - where at = zonedTimeToUTC zat - -storedFromHistory :: StoredHistory a -> Stored a -storedFromHistory sh = let History _ item _ = fromStored sh - in item - -storedHistoryList :: StoredHistory a -> [Stored a] -storedHistoryList = map snd . storedHistoryTimedList - -storedHistoryTimedList :: StoredHistory a -> [(ZonedTime, Stored a)] -storedHistoryTimedList sh = let History hinfo item prev = fromStored sh - in (infoDate hinfo, item) : maybe [] storedHistoryTimedList prev - -beginHistory :: Storable a => Storage -> StoreInfo -> a -> IO (StoredHistory a) -beginHistory st si x = do sx <- wrappedStore st x - wrappedStore st $ History si sx Nothing - -modifyHistory :: Storable a => StoreInfo -> (a -> a) -> StoredHistory a -> IO (StoredHistory a) -modifyHistory si f prev@(Stored (Ref st _) _) = do - sx <- wrappedStore st $ f $ fromHistory prev - wrappedStore st $ History si sx (Just prev) - - showRatio :: Rational -> String showRatio r = case decimalRatio r of Just (n, 1) -> show n |