{-# 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 #-}
module Data.Record.Anon.Internal.Core.Canonical (
Canonical
, getAtIndex
, setAtIndex
, fromRowOrderList
, toRowOrderList
, fromRowOrderArray
, toRowOrderArray
, arrayIndicesInRowOrder
, insert
, lens
, map
, mapM
, zipWith
, zipWithM
, collapse
, sequenceA
, ap
#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)
newtype Canonical (f :: k -> Type) = Canonical {
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
(Canonical f -> Canonical f -> Canonical f)
-> (NonEmpty (Canonical f) -> Canonical f)
-> (forall b. Integral b => b -> Canonical f -> Canonical f)
-> Semigroup (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
$c<> :: forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
<> :: Canonical f -> Canonical f -> Canonical f
$csconcat :: forall k (f :: k -> *). NonEmpty (Canonical f) -> Canonical f
sconcat :: NonEmpty (Canonical f) -> Canonical f
$cstimes :: forall k (f :: k -> *) b.
Integral b =>
b -> Canonical f -> Canonical f
stimes :: forall b. Integral b => b -> Canonical f -> Canonical f
Semigroup, Semigroup (Canonical f)
Canonical f
Semigroup (Canonical f) =>
Canonical f
-> (Canonical f -> Canonical f -> Canonical f)
-> ([Canonical f] -> Canonical f)
-> Monoid (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
$cmempty :: forall k (f :: k -> *). Canonical f
mempty :: Canonical f
$cmappend :: forall k (f :: k -> *). Canonical f -> Canonical f -> Canonical f
mappend :: Canonical f -> Canonical f -> Canonical f
$cmconcat :: forall k (f :: k -> *). [Canonical f] -> Canonical f
mconcat :: [Canonical f] -> Canonical f
Monoid)
type role Canonical representational
deriving instance Show a => Show (Canonical (K a))
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 StrictArray ReverseIndex (f Any) -> ReverseIndex -> f Any
forall i a. ArrayIndex i => StrictArray i a -> i -> a
Strict.! Int -> ReverseIndex
Strict.ReverseIndex Int
ix
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) = StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any)
v StrictArray ReverseIndex (f Any)
-> [(ReverseIndex, f Any)] -> StrictArray ReverseIndex (f Any)
forall i a.
ArrayIndex i =>
StrictArray i a -> [(i, a)] -> StrictArray i a
Strict.// [(Int, f Any)] -> [(ReverseIndex, f Any)]
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 = [(Int, f Any)] -> [(ReverseIndex, f Any)]
forall a b. Coercible a b => a -> b
coerce
fromRowOrderList :: [f Any] -> Canonical f
fromRowOrderList :: forall {k} (f :: k -> *). [f Any] -> Canonical f
fromRowOrderList = StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any) -> Canonical f)
-> ([f Any] -> StrictArray ReverseIndex (f Any))
-> [f Any]
-> Canonical f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [f Any] -> StrictArray ReverseIndex (f Any)
forall a i. [a] -> StrictArray i a
Strict.fromList
toRowOrderList :: Canonical f -> [f Any]
toRowOrderList :: forall {k} (f :: k -> *). Canonical f -> [f Any]
toRowOrderList = StrictArray ReverseIndex (f Any) -> [f Any]
forall a. StrictArray ReverseIndex a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (StrictArray ReverseIndex (f Any) -> [f Any])
-> (Canonical f -> StrictArray ReverseIndex (f Any))
-> Canonical f
-> [f Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Canonical f -> StrictArray ReverseIndex (f Any)
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 = StrictArray ReverseIndex (f Any) -> SmallArray (f Any)
forall i a. StrictArray i a -> SmallArray a
Strict.toLazy (StrictArray ReverseIndex (f Any) -> SmallArray (f Any))
-> (Canonical f -> StrictArray ReverseIndex (f Any))
-> Canonical f
-> SmallArray (f Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Canonical f -> StrictArray ReverseIndex (f Any)
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 = StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any) -> Canonical f)
-> (SmallArray (f Any) -> StrictArray ReverseIndex (f Any))
-> SmallArray (f Any)
-> Canonical f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmallArray (f Any) -> StrictArray ReverseIndex (f Any)
forall i a. SmallArray a -> StrictArray i a
Strict.fromLazy
arrayIndicesInRowOrder :: Int -> [Int]
arrayIndicesInRowOrder :: Int -> [Int]
arrayIndicesInRowOrder Int
0 = []
arrayIndicesInRowOrder Int
n = (ReverseIndex -> Int) -> [ReverseIndex] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Int -> ReverseIndex -> Int
forall i. ArrayIndex i => Int -> i -> Int
Strict.arrayIndex Int
n) [
Int -> ReverseIndex
Strict.ReverseIndex Int
i
| Int
i <- [Int
0 .. Int -> Int
forall a. Enum a => a -> a
pred Int
n]
]
insert :: forall f. [f Any] -> Canonical f -> Canonical f
insert :: forall {k} (f :: k -> *). [f Any] -> Canonical f -> Canonical f
insert [] = Canonical f -> Canonical f
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) = StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical ([f Any] -> StrictArray ReverseIndex (f Any)
forall a i. [a] -> StrictArray i a
Strict.fromList [f Any]
new StrictArray ReverseIndex (f Any)
-> StrictArray ReverseIndex (f Any)
-> StrictArray ReverseIndex (f Any)
forall a. Semigroup a => a -> a -> a
<> StrictArray ReverseIndex (f Any)
v)
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) = (
StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any) -> Canonical f)
-> StrictArray ReverseIndex (f Any) -> Canonical f
forall a b. (a -> b) -> a -> b
$
StrictArray ReverseIndex (f Any)
-> [ReverseIndex] -> StrictArray ReverseIndex (f Any)
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') -> StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any) -> Canonical f)
-> StrictArray ReverseIndex (f Any) -> Canonical f
forall a b. (a -> b) -> a -> b
$
StrictArray ReverseIndex (f Any)
-> [(ReverseIndex, f Any)] -> StrictArray ReverseIndex (f Any)
forall i a.
ArrayIndex i =>
StrictArray i a -> [(i, a)] -> StrictArray i a
Strict.update StrictArray ReverseIndex (f Any)
v ([ReverseIndex] -> [f Any] -> [(ReverseIndex, f Any)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [ReverseIndex]
co [Int]
is) ([f Any] -> [(ReverseIndex, f Any)])
-> [f Any] -> [(ReverseIndex, f Any)]
forall a b. (a -> b) -> a -> b
$ StrictArray ReverseIndex (f Any) -> [f Any]
forall a. StrictArray ReverseIndex a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictArray ReverseIndex (f Any)
v')
)
where
co :: [Int] -> [Strict.ReverseIndex]
co :: [Int] -> [ReverseIndex]
co = [Int] -> [ReverseIndex]
forall a b. Coercible a b => a -> b
coerce
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) = StrictArray ReverseIndex (g Any) -> Canonical g
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (g Any) -> Canonical g)
-> StrictArray ReverseIndex (g Any) -> Canonical g
forall a b. (a -> b) -> a -> b
$ (f Any -> g Any)
-> StrictArray ReverseIndex (f Any)
-> StrictArray ReverseIndex (g Any)
forall a b.
(a -> b)
-> StrictArray ReverseIndex a -> StrictArray ReverseIndex b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f Any -> g Any
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) = StrictArray ReverseIndex (g Any) -> Canonical g
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (g Any) -> Canonical g)
-> m (StrictArray ReverseIndex (g Any)) -> m (Canonical g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f Any -> m (g Any))
-> StrictArray ReverseIndex (f Any)
-> m (StrictArray ReverseIndex (g Any))
forall (m :: * -> *) i a b.
Applicative m =>
(a -> m b) -> StrictArray i a -> m (StrictArray i b)
Strict.mapM f Any -> m (g Any)
forall (x :: k). f x -> m (g x)
f StrictArray ReverseIndex (f Any)
v
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') = StrictArray ReverseIndex (h Any) -> Canonical h
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (h Any) -> Canonical h)
-> StrictArray ReverseIndex (h Any) -> Canonical h
forall a b. (a -> b) -> a -> b
$ (f Any -> g Any -> h Any)
-> StrictArray ReverseIndex (f Any)
-> StrictArray ReverseIndex (g Any)
-> StrictArray ReverseIndex (h Any)
forall a b c i.
(a -> b -> c)
-> StrictArray i a -> StrictArray i b -> StrictArray i c
Strict.zipWith f Any -> g Any -> h Any
forall (x :: k). f x -> g x -> h x
f StrictArray ReverseIndex (f Any)
v StrictArray ReverseIndex (g Any)
v'
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') = StrictArray ReverseIndex (h Any) -> Canonical h
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (h Any) -> Canonical h)
-> m (StrictArray ReverseIndex (h Any)) -> m (Canonical h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f Any -> g Any -> m (h Any))
-> StrictArray ReverseIndex (f Any)
-> StrictArray ReverseIndex (g Any)
-> m (StrictArray ReverseIndex (h Any))
forall (m :: * -> *) a b c i.
Applicative m =>
(a -> b -> m c)
-> StrictArray i a -> StrictArray i b -> m (StrictArray i c)
Strict.zipWithM f Any -> g Any -> m (h Any)
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) = [K a Any] -> [a]
forall {k} a. [K a Any] -> [a]
co ([K a Any] -> [a]) -> [K a Any] -> [a]
forall a b. (a -> b) -> a -> b
$ StrictArray ReverseIndex (K a Any) -> [K a Any]
forall a. StrictArray ReverseIndex a -> [a]
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 = [K a Any] -> [a]
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) = StrictArray ReverseIndex (f Any) -> Canonical f
forall k (f :: k -> *).
StrictArray ReverseIndex (f Any) -> Canonical f
Canonical (StrictArray ReverseIndex (f Any) -> Canonical f)
-> m (StrictArray ReverseIndex (f Any)) -> m (Canonical f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:.:) m f Any -> m (f Any))
-> StrictArray ReverseIndex ((:.:) m f Any)
-> m (StrictArray ReverseIndex (f Any))
forall (m :: * -> *) i a b.
Applicative m =>
(a -> m b) -> StrictArray i a -> m (StrictArray i b)
Strict.mapM (:.:) m f Any -> m (f Any)
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 (x :: k). (-.->) f g x -> f x -> g x)
-> Canonical (f -.-> g) -> Canonical f -> Canonical g
forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> Canonical f -> Canonical g -> Canonical h
zipWith (-.->) f g x -> f x -> g x
forall (x :: k). (-.->) f g x -> f x -> g x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn
#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