{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE RoleAnnotations     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}

-- | Record diff
--
-- Intended for qualified import.
--
-- > import Data.Record.Anonymous.Internal.Diff (Diff)
-- > import qualified Data.Record.Anonymous.Internal.Diff as Diff
module Data.Record.Anon.Internal.Core.Diff (
    Diff(..)
    -- * Incremental construction
  , empty
  , get
  , set
  , insert
    -- * Batch operations
  , apply
    -- * Debugging support
#if DEBUG
  , toString
#endif
  ) where

import Data.IntMap (IntMap)
import Data.Kind
import Data.List.NonEmpty (NonEmpty(..), (<|))
import Data.SOP.BasicFunctors
import GHC.Exts (Any)
import qualified Data.IntMap.Strict as IntMap

#if DEBUG
import Debug.RecoverRTTI (AnythingToString(..))
import Data.Record.Generic.Rep.Internal (noInlineUnsafeCo)
#endif

import qualified Data.List.NonEmpty as NE

import Data.Record.Anon.Internal.Core.Canonical (Canonical(..))
import Data.Record.Anon.Internal.Core.FieldName (FieldName)
import Data.Record.Anon.Internal.Util.SmallHashMap (SmallHashMap)

import qualified Data.Record.Anon.Internal.Core.Canonical    as Canon
import qualified Data.Record.Anon.Internal.Util.SmallHashMap as HashMap

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Record changes to a ('Canonical') record.
--
-- Unlike 'Canon.set' and 'Canon.insert', 'Diff.set' and 'Diff.insert' deal with
-- a single field at a time, at @O(1)@ cost. This is the raison d'être of
-- 'Diff': amortize the cost of repeated updates/inserts. Specifically, a series
-- of inserts or updates will build a 'Diff' which will take @O(n)@ to apply,
-- but that 'apply' should be /executed/ only when we do an operation which is
-- @O(n)@ anyway, thereby absorbing the cost.
--
-- This is also the reason that 'Diff' is name based, not index based: inserting
-- a new field would increase all indices of existing fields by 1, an inherently
-- @O(n)@ operation.
--
-- NOTE: As for 'Canonical', when citing algorithmic complexity of operations on
-- 'Diff', we assume that 'HashMap' inserts and lookups are @O(1)@. See
-- 'Canonical' for more detailed justification.
--
-- NOTE: Since @large-anon@ currently only supports records with strict fields,
-- we use strict 'HashMap' here.
data Diff (f :: k -> Type) = Diff {
      -- | New values of existing fields
      --
      -- Indices refer to the original record.
      forall k (f :: k -> *). Diff f -> IntMap (f Any)
diffUpd :: !(IntMap (f Any))

      -- | List of new fields, most recently inserted first
      --
      -- May contain duplicates: fields inserted later shadow earlier fields.
    , forall k (f :: k -> *). Diff f -> [FieldName]
diffIns :: [FieldName]

      -- | Values for the newly inserted fields
      --
      -- If the field is shadowed, the list will have multiple entries. Entries
      -- in the lists are from new to old, so the head of the list is the
      -- "currently visible" entry.
    , forall k (f :: k -> *).
Diff f -> SmallHashMap FieldName (NonEmpty (f Any))
diffNew :: !(SmallHashMap FieldName (NonEmpty (f Any)))
    }

type role Diff representational

deriving instance Show a => Show (Diff (K a))

{-------------------------------------------------------------------------------
  Incremental construction

  TODO: We should property check these postconditions.
-------------------------------------------------------------------------------}

-- | Empty difference
--
-- Postcondition:
--
-- > apply empty c == c
empty :: Diff f
empty :: forall {k} (f :: k -> *). Diff f
empty = Diff {
      diffUpd :: IntMap (f Any)
diffUpd = forall a. IntMap a
IntMap.empty
    , diffIns :: [FieldName]
diffIns = []
    , diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffNew = forall k a. SmallHashMap k a
HashMap.empty
    }

-- | Get field
--
-- Precondition: field must be present in the diff or in the record.
-- Postcondition:
--
-- > Diff.get f d c == Canon.get f (Diff.apply d c)
--
-- @O(1)@.
get :: (Int, FieldName) -> Diff f -> Canonical f -> f Any
get :: forall {k} (f :: k -> *).
(Int, FieldName) -> Diff f -> Canonical f -> f Any
get (Int
i, FieldName
f) Diff{[FieldName]
IntMap (f Any)
SmallHashMap FieldName (NonEmpty (f Any))
diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: [FieldName]
diffUpd :: IntMap (f Any)
diffNew :: forall k (f :: k -> *).
Diff f -> SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: forall k (f :: k -> *). Diff f -> [FieldName]
diffUpd :: forall k (f :: k -> *). Diff f -> IntMap (f Any)
..} Canonical f
c =
    case forall k a. (Hashable k, Ord k) => k -> SmallHashMap k a -> Maybe a
HashMap.lookup FieldName
f SmallHashMap FieldName (NonEmpty (f Any))
diffNew of
      Just NonEmpty (f Any)
xs -> forall a. NonEmpty a -> a
NE.head NonEmpty (f Any)
xs                          -- inserted  in the diff
      Maybe (NonEmpty (f Any))
Nothing -> case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap (f Any)
diffUpd of
                   Just f Any
x  -> f Any
x                      -- updated   in the diff
                   Maybe (f Any)
Nothing -> forall {k} (f :: k -> *). Canonical f -> Int -> f Any
Canon.getAtIndex Canonical f
c Int
i   -- unchanged in the diff

-- | Update existing field
--
-- Precondition: field must be present in the diff or in the record.
-- Postcondition:
--
-- > Diff.apply (Diff.set f x c d) c == Canon.set [(f, x)] (apply d c)
--
-- It is useful to spell out what happens when inserts and updated are mixed:
--
-- * When a field is inserted and then updated, we just update the corresponding
--   entry in 'diffNew'.
-- * When an /existing/ field is first updated and then a new field with the
--   same name is added, an entry is added to 'diffNew' but 'diffUpd' will also
--   contain an entry for this field. This doesn't matter: when the diff is
--   applied, the new field will shadow the old, and when we 'get' the value
--   of a field, we similarly /first/ check 'diffNew'.
-- * When the /same/ field is inserted more than once, updates to that field
--   will effectively affect all of them (since we store only a single value),
--   but only the first value will matter as it will shadow all the others.
--
-- @O(1)@.
set :: forall f. (Int, FieldName) -> f Any -> Diff f -> Diff f
set :: forall {k} (f :: k -> *).
(Int, FieldName) -> f Any -> Diff f -> Diff f
set (Int
i, FieldName
f) f Any
x d :: Diff f
d@Diff{[FieldName]
IntMap (f Any)
SmallHashMap FieldName (NonEmpty (f Any))
diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: [FieldName]
diffUpd :: IntMap (f Any)
diffNew :: forall k (f :: k -> *).
Diff f -> SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: forall k (f :: k -> *). Diff f -> [FieldName]
diffUpd :: forall k (f :: k -> *). Diff f -> IntMap (f Any)
..} =
    case forall k a b.
(Hashable k, Ord k) =>
k
-> (a -> (b, Maybe a))
-> SmallHashMap k a
-> Maybe (b, SmallHashMap k a)
HashMap.alterExisting FieldName
f NonEmpty (f Any) -> ((), Maybe (NonEmpty (f Any)))
updateInserted SmallHashMap FieldName (NonEmpty (f Any))
diffNew of
      Just ((), SmallHashMap FieldName (NonEmpty (f Any))
diffNew') -> Diff f
d { diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffNew = SmallHashMap FieldName (NonEmpty (f Any))
diffNew' }
      Maybe ((), SmallHashMap FieldName (NonEmpty (f Any)))
Nothing             -> Diff f
d { diffUpd :: IntMap (f Any)
diffUpd = forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i f Any
x IntMap (f Any)
diffUpd }
  where
    updateInserted :: NonEmpty (f Any) -> ((), Maybe (NonEmpty (f Any)))
    updateInserted :: NonEmpty (f Any) -> ((), Maybe (NonEmpty (f Any)))
updateInserted (f Any
_ :| [f Any]
prev) = ((), forall a. a -> Maybe a
Just (f Any
x forall a. a -> [a] -> NonEmpty a
:| [f Any]
prev))

-- | Insert new field
--
-- Precondition: none (if the field already exists, it will be shadowed).
-- Postcondition:
--
-- > Diff.apply (Diff.insert f x d) c = Canon.insert [(f, x)] (apply d c)
--
-- @(1)@.
insert :: forall f. FieldName -> f Any -> Diff f -> Diff f
insert :: forall {k} (f :: k -> *). FieldName -> f Any -> Diff f -> Diff f
insert FieldName
f f Any
x d :: Diff f
d@Diff{[FieldName]
IntMap (f Any)
SmallHashMap FieldName (NonEmpty (f Any))
diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: [FieldName]
diffUpd :: IntMap (f Any)
diffNew :: forall k (f :: k -> *).
Diff f -> SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: forall k (f :: k -> *). Diff f -> [FieldName]
diffUpd :: forall k (f :: k -> *). Diff f -> IntMap (f Any)
..} = Diff f
d {
      diffIns :: [FieldName]
diffIns = FieldName
f forall a. a -> [a] -> [a]
: [FieldName]
diffIns
    , diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffNew = forall k a.
(Hashable k, Ord k) =>
(Maybe a -> Maybe a) -> k -> SmallHashMap k a -> SmallHashMap k a
HashMap.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NonEmpty (f Any)) -> NonEmpty (f Any)
insertField) FieldName
f SmallHashMap FieldName (NonEmpty (f Any))
diffNew
    }
  where
    insertField :: Maybe (NonEmpty (f Any)) -> NonEmpty (f Any)
    insertField :: Maybe (NonEmpty (f Any)) -> NonEmpty (f Any)
insertField Maybe (NonEmpty (f Any))
Nothing     = f Any
x forall a. a -> [a] -> NonEmpty a
:| []
    insertField (Just NonEmpty (f Any)
prev) = f Any
x forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty (f Any)
prev

{-------------------------------------------------------------------------------
  Batch operations
-------------------------------------------------------------------------------}

-- | All new fields (including shadowed fields), from new to old
--
-- @O(n)@.
allNewFields :: Diff f -> [f Any]
allNewFields :: forall {k} (f :: k -> *). Diff f -> [f Any]
allNewFields = \Diff{[FieldName]
IntMap (f Any)
SmallHashMap FieldName (NonEmpty (f Any))
diffNew :: SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: [FieldName]
diffUpd :: IntMap (f Any)
diffNew :: forall k (f :: k -> *).
Diff f -> SmallHashMap FieldName (NonEmpty (f Any))
diffIns :: forall k (f :: k -> *). Diff f -> [FieldName]
diffUpd :: forall k (f :: k -> *). Diff f -> IntMap (f Any)
..} -> forall {k} (f :: k -> *).
SmallHashMap FieldName (NonEmpty (f Any)) -> [FieldName] -> [f Any]
go SmallHashMap FieldName (NonEmpty (f Any))
diffNew [FieldName]
diffIns
  where
    go :: SmallHashMap FieldName (NonEmpty (f Any)) -> [FieldName] -> [f Any]
    go :: forall {k} (f :: k -> *).
SmallHashMap FieldName (NonEmpty (f Any)) -> [FieldName] -> [f Any]
go SmallHashMap FieldName (NonEmpty (f Any))
_  []     = []
    go SmallHashMap FieldName (NonEmpty (f Any))
vs (FieldName
x:[FieldName]
xs) = case forall k a b.
(Hashable k, Ord k) =>
k
-> (a -> (b, Maybe a))
-> SmallHashMap k a
-> Maybe (b, SmallHashMap k a)
HashMap.alterExisting FieldName
x forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons SmallHashMap FieldName (NonEmpty (f Any))
vs of
                     Maybe (f Any, SmallHashMap FieldName (NonEmpty (f Any)))
Nothing       -> forall a. HasCallStack => String -> a
error String
"allNewFields: invariant violation"
                     Just (f Any
v, SmallHashMap FieldName (NonEmpty (f Any))
vs') -> f Any
v forall a. a -> [a] -> [a]
: forall {k} (f :: k -> *).
SmallHashMap FieldName (NonEmpty (f Any)) -> [FieldName] -> [f Any]
go SmallHashMap FieldName (NonEmpty (f Any))
vs' [FieldName]
xs

-- | Apply diff
--
-- @O(n)@ in the size of the 'Canonical' and the 'Diff' in general.
-- @O(1)@ if the `Diff` is empty.
apply :: forall f. Diff f -> Canonical f -> Canonical f
apply :: forall {k} (f :: k -> *). Diff f -> Canonical f -> Canonical f
apply Diff f
d =
      forall {k} (f :: k -> *). [f Any] -> Canonical f -> Canonical f
Canon.insert     (forall {k} (f :: k -> *). Diff f -> [f Any]
allNewFields Diff f
d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *).
[(Int, f Any)] -> Canonical f -> Canonical f
Canon.setAtIndex (forall a. IntMap a -> [(Int, a)]
IntMap.toList (forall k (f :: k -> *). Diff f -> IntMap (f Any)
diffUpd Diff f
d))

{-------------------------------------------------------------------------------
  Debugging support
-------------------------------------------------------------------------------}

#if DEBUG
toString :: forall k (f :: k -> Type). Diff f -> String
toString = show . mapDiff (K . AnythingToString . co)
  where
    mapDiff :: (forall x. f x -> g x) -> Diff f -> Diff g
    mapDiff f Diff{..} = Diff{
          diffUpd = fmap f diffUpd
        , diffIns = diffIns
        , diffNew = fmap (fmap f) diffNew
        }

    co :: f x -> f Any
    co = noInlineUnsafeCo
#endif