{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE RoleAnnotations            #-}

-- | Canonical gecord (i.e., no diff)
--
-- Intended for qualified import.
--
-- > import Data.Record.Anonymous.Internal.Canonical (Canonical)
-- > import qualified Data.Record.Anonymous.Internal.Canonical as Canon
module Data.Record.Anon.Internal.Core.Canonical (
    Canonical -- opaque
    -- * Indexed access
  , getAtIndex
  , setAtIndex
    -- * Conversion
  , fromRowOrderList
  , toRowOrderList
  , fromRowOrderArray
  , toRowOrderArray
  , arrayIndicesInRowOrder
    -- * Basic API
  , insert
  , lens
    -- * Simple (non-constrained) combinators
  , map
  , mapM
  , zipWith
  , zipWithM
  , collapse
  , sequenceA
  , ap
    -- * Debugging support
#if DEBUG
  , toString
#endif
  ) where

import Prelude hiding (map, mapM, zipWith, sequenceA, pure)
import qualified Prelude

import Data.Coerce (coerce)
import Data.Kind
import Data.SOP.BasicFunctors
import Data.SOP.Classes (type (-.->)(apFn))
import GHC.Exts (Any)

#if DEBUG
import Debug.RecoverRTTI (AnythingToString(..))
#endif

import qualified Data.Foldable as Foldable

import Data.Record.Anon.Internal.Util.StrictArray (StrictArray)

import qualified Data.Record.Anon.Internal.Util.StrictArray as Strict
import Data.Primitive (SmallArray)

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

-- | Canonical record representation
--
-- Canonicity here refers to the fact that we have no @Diff@ to apply (see
-- "Data.Record.Anonymous.Internal.Diff").
--
-- == Order
--
-- The record is represented as a strict vector in row order (@large-anon@ is
-- strict by default; lazy records can be achieved using boxing). This order is
-- important: it makes it possible to define functions such as @mapM@ (for which
-- ordering must be well-defined).
--
-- /Indices/ into the array however are interpreted from the /end/ of the array.
-- This ensures that when we insert new elements into the record, the indices of
-- the already existing fields do not change; see 'Diff' for further discussion.
--
-- == Shadowing
--
-- Type level shadowing is reflected at the term level: if a record has
-- duplicate fields in its type, it will have multiple entries for that field
-- in the vector.
--
-- TODO: Currently we have no way of recovering the value of shadowed fields,
-- adding an API for that is future work. The work by Daan Leijen on scoped
-- labels might offer some inspiration there.
--
-- == Note on complexity
--
-- When we cite the algorithmic complexity of operations on 'Canonical', we
-- assume that 'HashMap' inserts and lookups are @O(1)@, which they are in
-- practice (especially given the relatively small size of typical records),
-- even if theoretically they are @O(log n)@. See also the documentation of
-- "Data.HashMap.Strict".
newtype Canonical (f :: k -> Type) = Canonical {
      -- | To strict vector
      forall k (f :: k -> *).
Canonical f -> StrictArray ReverseIndex (f Any)
toVector :: StrictArray Strict.ReverseIndex (f Any)
    }
  deriving newtype (NonEmpty (Canonical f) -> Canonical f
Canonical f -> Canonical f -> Canonical f
forall b. Integral b => b -> Canonical f -> Canonical f
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (f :: k -> *). NonEmpty (Canonical f) -> Canonical f
forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
forall k (f :: k -> *) b.
Integral b =>
b -> Canonical f -> Canonical f
stimes :: forall b. Integral b => b -> Canonical f -> Canonical f
$cstimes :: forall k (f :: k -> *) b.
Integral b =>
b -> Canonical f -> Canonical f
sconcat :: NonEmpty (Canonical f) -> Canonical f
$csconcat :: forall k (f :: k -> *). NonEmpty (Canonical f) -> Canonical f
<> :: Canonical f -> Canonical f -> Canonical f
$c<> :: forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
Semigroup, Canonical f
[Canonical f] -> Canonical f
Canonical f -> Canonical f -> Canonical f
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall k (f :: k -> *). Semigroup (Canonical f)
forall k (f :: k -> *). Canonical f
forall k (f :: k -> *). [Canonical f] -> Canonical f
forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
mconcat :: [Canonical f] -> Canonical f
$cmconcat :: forall k (f :: k -> *). [Canonical f] -> Canonical f
mappend :: Canonical f -> Canonical f -> Canonical f
$cmappend :: forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
mempty :: Canonical f
$cmempty :: forall k (f :: k -> *). Canonical f
Monoid)

type role Canonical representational

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

{-------------------------------------------------------------------------------
  Indexed access
-------------------------------------------------------------------------------}

-- | Get field at the specified index
--
-- @O(1)@.
getAtIndex :: Canonical f -> Int -> f Any
getAtIndex :: forall {k} (f :: k -> *). Canonical f -> Int -> f Any
getAtIndex (Canonical StrictArray ReverseIndex (f Any)
c) Int
ix = StrictArray ReverseIndex (f Any)
c forall i a. ArrayIndex i => StrictArray i a -> i -> a
Strict.! Int -> ReverseIndex
Strict.ReverseIndex Int
ix

-- | Set fields at the specified indices
--
-- @O(n)@ in the size of the record (independent of the number of field updates)
-- @O(1)@ if the list of updates is empty.
setAtIndex :: [(Int, f Any)] -> Canonical f -> Canonical f
setAtIndex :: forall {k} (f :: k -> *).
[(Int, f Any)] -> Canonical f -> Canonical f
setAtIndex [] Canonical f
c             = Canonical f
c
setAtIndex [(Int, f Any)]
fs (Canonical StrictArray ReverseIndex (f Any)
v) = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any)
v forall i a.
ArrayIndex i =>
StrictArray i a -> [(i, a)] -> StrictArray i a
Strict.// forall {k} (f :: k -> *). [(Int, f Any)] -> [(ReverseIndex, f Any)]
co [(Int, f Any)]
fs)
  where
    co :: [(Int, f Any)] -> [(Strict.ReverseIndex, f Any)]
    co :: forall {k} (f :: k -> *). [(Int, f Any)] -> [(ReverseIndex, f Any)]
co = coerce :: forall a b. Coercible a b => a -> b
coerce

{-------------------------------------------------------------------------------
  Conversion
-------------------------------------------------------------------------------}

-- | From list of fields in row order
--
-- @O(n)@.
fromRowOrderList :: [f Any] -> Canonical f
fromRowOrderList :: forall {k} (f :: k -> *). [f Any] -> Canonical f
fromRowOrderList = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i. [a] -> StrictArray i a
Strict.fromList

-- | All fields in row order
--
-- @O(n)@
toRowOrderList :: Canonical f -> [f Any]
toRowOrderList :: forall {k} (f :: k -> *). Canonical f -> [f Any]
toRowOrderList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *).
Canonical f -> StrictArray ReverseIndex (f Any)
toVector

toRowOrderArray :: Canonical f -> SmallArray (f Any)
toRowOrderArray :: forall {k} (f :: k -> *). Canonical f -> SmallArray (f Any)
toRowOrderArray = forall i a. StrictArray i a -> SmallArray a
Strict.toLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *).
Canonical f -> StrictArray ReverseIndex (f Any)
toVector

fromRowOrderArray :: SmallArray (f Any) -> Canonical f
fromRowOrderArray :: forall {k} (f :: k -> *). SmallArray (f Any) -> Canonical f
fromRowOrderArray = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. SmallArray a -> StrictArray i a
Strict.fromLazy

-- | Given the length of the array, all indices in row order
arrayIndicesInRowOrder :: Int -> [Int]
arrayIndicesInRowOrder :: Int -> [Int]
arrayIndicesInRowOrder Int
0 = []
arrayIndicesInRowOrder Int
n = forall a b. (a -> b) -> [a] -> [b]
Prelude.map (forall i. ArrayIndex i => Int -> i -> Int
Strict.arrayIndex Int
n) [
                               Int -> ReverseIndex
Strict.ReverseIndex Int
i
                             | Int
i <- [Int
0 .. forall a. Enum a => a -> a
pred Int
n]
                             ]

{-------------------------------------------------------------------------------
  Basic API
-------------------------------------------------------------------------------}

-- | Insert fields into the record
--
-- It is the responsibility of the caller to make sure that the linear
-- concatenation of the new fields to the existing record matches the row order
-- of the new record.
--
-- @O(n)@ in the number of inserts and the size of the record.
-- @O(1)@ if the list of inserts is empty.
insert :: forall f. [f Any] -> Canonical f -> Canonical f
insert :: forall {k} (f :: k -> *). [f Any] -> Canonical f -> Canonical f
insert []  = forall a. a -> a
id
insert [f Any]
new = Canonical f -> Canonical f
prepend
  where
     prepend :: Canonical f -> Canonical f
     prepend :: Canonical f -> Canonical f
prepend (Canonical StrictArray ReverseIndex (f Any)
v) = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (forall a i. [a] -> StrictArray i a
Strict.fromList [f Any]
new forall a. Semigroup a => a -> a -> a
<> StrictArray ReverseIndex (f Any)
v)

-- | Project out some fields in the selected order
--
-- It is the responsibility of the caller that the list of indices is in row
-- order of the new record.
--
-- @O(n)@ (in both directions)
lens :: [Int] -> Canonical f -> (Canonical f, Canonical f -> Canonical f)
lens :: forall {k} (f :: k -> *).
[Int] -> Canonical f -> (Canonical f, Canonical f -> Canonical f)
lens [Int]
is (Canonical StrictArray ReverseIndex (f Any)
v) = (
      forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall a b. (a -> b) -> a -> b
$
        forall i a.
ArrayIndex i =>
StrictArray i a -> [i] -> StrictArray i a
Strict.backpermute StrictArray ReverseIndex (f Any)
v ([Int] -> [ReverseIndex]
co [Int]
is)
    , \(Canonical StrictArray ReverseIndex (f Any)
v') -> forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall a b. (a -> b) -> a -> b
$
         forall i a.
ArrayIndex i =>
StrictArray i a -> [(i, a)] -> StrictArray i a
Strict.update StrictArray ReverseIndex (f Any)
v (forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [ReverseIndex]
co [Int]
is) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictArray ReverseIndex (f Any)
v')
    )
  where
    co :: [Int] -> [Strict.ReverseIndex]
    co :: [Int] -> [ReverseIndex]
co = coerce :: forall a b. Coercible a b => a -> b
coerce

{-------------------------------------------------------------------------------
  Simple (non-constrained) combinators
-------------------------------------------------------------------------------}

map :: (forall x. f x -> g x) -> Canonical f -> Canonical g
map :: forall {k} (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x) -> Canonical f -> Canonical g
map forall (x :: k). f x -> g x
f (Canonical StrictArray ReverseIndex (f Any)
v) = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (x :: k). f x -> g x
f StrictArray ReverseIndex (f Any)
v

mapM ::
     Applicative m
  => (forall x. f x -> m (g x))
  -> Canonical f -> m (Canonical g)
mapM :: forall {k} (m :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative m =>
(forall (x :: k). f x -> m (g x)) -> Canonical f -> m (Canonical g)
mapM forall (x :: k). f x -> m (g x)
f (Canonical StrictArray ReverseIndex (f Any)
v) = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i a b.
Applicative m =>
(a -> m b) -> StrictArray i a -> m (StrictArray i b)
Strict.mapM forall (x :: k). f x -> m (g x)
f StrictArray ReverseIndex (f Any)
v

-- | Zip two records
--
-- Precondition: the two records must have the same shape.
zipWith ::
     (forall x. f x -> g x -> h x)
  -> Canonical f -> Canonical g -> Canonical h
zipWith :: forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Canonical f -> Canonical g -> Canonical h
zipWith forall (x :: k). f x -> g x -> h x
f (Canonical StrictArray ReverseIndex (f Any)
v) (Canonical StrictArray ReverseIndex (g Any)
v') = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall a b. (a -> b) -> a -> b
$ forall a b c i.
(a -> b -> c)
-> StrictArray i a -> StrictArray i b -> StrictArray i c
Strict.zipWith forall (x :: k). f x -> g x -> h x
f StrictArray ReverseIndex (f Any)
v StrictArray ReverseIndex (g Any)
v'

-- | Applicative zip of two records
--
-- Precondition: the two records must have the same shape.
zipWithM ::
     Applicative m
  => (forall x. f x -> g x -> m (h x))
  -> Canonical f -> Canonical g -> m (Canonical h)
zipWithM :: forall {k} (m :: * -> *) (f :: k -> *) (g :: k -> *) (h :: k -> *).
Applicative m =>
(forall (x :: k). f x -> g x -> m (h x))
-> Canonical f -> Canonical g -> m (Canonical h)
zipWithM forall (x :: k). f x -> g x -> m (h x)
f (Canonical StrictArray ReverseIndex (f Any)
v) (Canonical StrictArray ReverseIndex (g Any)
v') = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c i.
Applicative m =>
(a -> b -> m c)
-> StrictArray i a -> StrictArray i b -> m (StrictArray i c)
Strict.zipWithM forall (x :: k). f x -> g x -> m (h x)
f StrictArray ReverseIndex (f Any)
v StrictArray ReverseIndex (g Any)
v'

collapse :: Canonical (K a) -> [a]
collapse :: forall {k} a. Canonical (K a) -> [a]
collapse (Canonical StrictArray ReverseIndex (K a Any)
v) = forall {k} a. [K a Any] -> [a]
co forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictArray ReverseIndex (K a Any)
v
  where
    co :: [K a Any] -> [a]
    co :: forall {k} a. [K a Any] -> [a]
co = coerce :: forall a b. Coercible a b => a -> b
coerce

sequenceA :: Applicative m => Canonical (m :.: f) -> m (Canonical f)
sequenceA :: forall {k} (m :: * -> *) (f :: k -> *).
Applicative m =>
Canonical (m :.: f) -> m (Canonical f)
sequenceA (Canonical StrictArray ReverseIndex ((:.:) m f Any)
v) = forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i a b.
Applicative m =>
(a -> m b) -> StrictArray i a -> m (StrictArray i b)
Strict.mapM forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp StrictArray ReverseIndex ((:.:) m f Any)
v

ap :: Canonical (f -.-> g) -> Canonical f -> Canonical g
ap :: forall {k} (f :: k -> *) (g :: k -> *).
Canonical (f -.-> g) -> Canonical f -> Canonical g
ap = forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Canonical f -> Canonical g -> Canonical h
zipWith forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn

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

#if DEBUG
toString :: forall k (f :: k -> Type). Canonical f -> String
toString = show . aux
  where
    aux :: Canonical f -> Canonical (K (AnythingToString (f Any)))
    aux = coerce
#endif