incremental 0 → 0.1

raw patch · 2 files changed

+56/−10 lines, 2 filesdep +aesondep +extensibledep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, extensible, text

API changes (from Hackage documentation)

Files

• incremental.cabal +4/−1
• src/Data/Incremental.hs +52/−9

@@ -1,5 +1,5 @@ name:                incremental-version:             0+version:             0.1 synopsis:            incremental update library description:         Generic interface for incremental updates homepage:            https://github.com/fumieval/incremental#readme@@ -17,6 +17,9 @@   hs-source-dirs:      src   exposed-modules:     Data.Incremental   build-depends:       base >= 4.8 && <5, containers, semigroups, deepseq+    , extensible >= 0.6.1 && <0.7+    , aeson+    , text   ghc-options: -Wall   default-language:    Haskell2010 

@@ -3,28 +3,39 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PolyKinds #-} module Data.Incremental (   Incremental(..)   , Alter(..)   , Hetero(..)   , Fresh(..)+  , WrapDelta(..) ) where  import Control.Applicative import Control.DeepSeq+import qualified Data.Aeson as J import Data.Fixed import Data.Functor.Identity import Data.Semigroup hiding (diff) import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map+import Data.Maybe import Data.Proxy import qualified Data.Set as Set import Data.Void import Data.Int import Data.Word+import Data.Extensible+import Data.Text (Text) import Numeric.Natural import GHC.Generics @@ -61,13 +72,16 @@   patch (Const a) d = Const (patch a d)   diff (Const a) (Const b) = diff a b -data Alter a = Insert a | Update (Delta a) | Delete | Upsert a (Delta a)-  deriving Generic+data Alter a d = Insert a | Update d | Delete | Upsert a d+  deriving (Generic, Functor) -deriving instance (Show a, Show (Delta a)) => Show (Alter a)-instance (NFData a, NFData (Delta a)) => NFData (Alter a)+deriving instance (Show a, Show d) => Show (Alter a d)+instance (NFData a, NFData d) => NFData (Alter a d) -instance (Incremental a, Semigroup (Delta a)) => Semigroup (Alter a) where+instance (J.FromJSON a, J.FromJSON d) => J.FromJSON (Alter a d)+instance (J.ToJSON a, J.ToJSON d) => J.ToJSON (Alter a d)++instance (Incremental a, d ~ Delta a, Semigroup d) => Semigroup (Alter a d) where   _ <> Insert a = Insert a   _ <> Delete = Delete   Insert a <> Update d = Insert (patch a d)@@ -79,12 +93,12 @@   Upsert a d <> Update e = Upsert a (d <> e)   Upsert a d <> Upsert _ e = Upsert a (d <> e) -instance (Incremental a, Semigroup (Delta a), Monoid (Delta a)) => Monoid (Alter a) where+instance (Incremental a, Monoid d, d ~ Delta a) => Monoid (Alter a d) where   mempty = Update mempty   mappend = (<>)  instance Incremental a => Incremental (Maybe a) where-  type Delta (Maybe a) = Alter a+  type Delta (Maybe a) = Alter a (Delta a)   patch _ (Insert a) = Just a   patch (Just a) (Update d) = Just $! patch a d   patch (Just a) (Upsert _ d) = Just $! patch a d@@ -106,7 +120,7 @@   diff (a, b, c) (d, e, f) = Just (diff a d, diff b e, diff c f)  instance (Incremental a) => Incremental (IntMap.IntMap a) where-  type Delta (IntMap.IntMap a) = IntMap.IntMap (Alter a)+  type Delta (IntMap.IntMap a) = IntMap.IntMap (Alter a (Delta a))   patch = IntMap.mergeWithKey (\_ a -> patch (Just a)) id     $ IntMap.mapMaybe $ \case       Insert a -> Just a@@ -117,7 +131,7 @@       check m = if IntMap.null m then Nothing else Just m  instance (Ord k, Incremental a) => Incremental (Map.Map k a) where-  type Delta (Map.Map k a) = Map.Map k (Alter a)+  type Delta (Map.Map k a) = Map.Map k (Alter a (Delta a))   patch = Map.mergeWithKey (\_ a -> patch (Just a)) id     $ Map.mapMaybe $ \case       Insert a -> Just a@@ -146,6 +160,13 @@   patch = (<>)   diff (Sum a) (Sum b) = Just $ Sum (b - a) +instance Eq a => Incremental [a] where+  type Delta [a] = [a]+  patch _ xs = xs+  diff a b+    | a == b = Nothing+    | otherwise = Just b+ newtype Hetero a = Hetero { getHetero :: a }   deriving (Bounded, Enum, Eq, Floating, Fractional, Integral, Semigroup       , Monoid, Num, Ord, Real, RealFrac, RealFloat, Generic, NFData)@@ -174,6 +195,27 @@   diff a b = if a /= b then Just b else Nothing; \   } +newtype WrapDelta h x = WrapDelta { unwrapDelta :: Maybe (Delta (h x)) }+deriving instance Show (Delta (h x)) => Show (WrapDelta h x)+deriving instance Eq (Delta (h x)) => Eq (WrapDelta h x)+deriving instance Ord (Delta (h x)) => Ord (WrapDelta h x)+deriving instance J.FromJSON (Delta (h x)) => J.FromJSON (WrapDelta h x)+deriving instance J.ToJSON (Delta (h x)) => J.ToJSON (WrapDelta h x)++deriving instance Incremental (h (TargetOf kv)) => Incremental (Field h kv)++instance WrapForall Incremental h xs => Incremental (xs :& h) where+  type Delta (xs :& h) = xs :& WrapDelta h+  patch r = hmapWithIndexFor (Proxy :: Proxy (Instance1 Incremental h))+    (\i (WrapDelta d) -> maybe (hlookup i r) (patch (hlookup i r)) d)+  diff r = check+    . hmapWithIndexFor (Proxy :: Proxy (Instance1 Incremental h))+    (\i x -> WrapDelta (diff (hlookup i r) x))+    where+      check t+        | getAny $ hfoldMap (Any . isJust . unwrapDelta) t = Just t+        | otherwise = Nothing+ TRIVIAL_EQ(Bool) TRIVIAL_EQ(Char) TRIVIAL_EQ(Double)@@ -192,3 +234,4 @@ TRIVIAL_EQ(Word16) TRIVIAL_EQ(Word32) TRIVIAL_EQ(Word64)+TRIVIAL_EQ(Text)