{-# LANGUAGE TypeFamilies #-}
module Data.Array.Comfort.Container (
C(..), EqShape(..), NFShape(..), Indexed(..),
) where
import qualified Data.Array.Comfort.Shape as Shape
import Control.DeepSeq (NFData, rnf)
import qualified Data.NonEmpty.Map as NonEmptyMap
import qualified Data.NonEmpty.Set as NonEmptySet
import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Empty as Empty
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Map (Map)
import Data.Set (Set)
import Data.Foldable (Foldable)
import Data.Maybe (fromMaybe)
class (Foldable f) => C f where
data Shape f
shapeSize :: Shape f -> Int
fromList :: Shape f -> [a] -> f a
toShape :: f a -> Shape f
class (C f) => NFShape f where
rnfShape :: Shape f -> ()
class (C f) => EqShape f where
eqShape :: Shape f -> Shape f -> Bool
class (C f) => Indexed f where
type Index f
indices :: Shape f -> [Index f]
unifiedSizeOffset ::
(Shape.Checking check) =>
Shape f -> (Int, Index f -> Shape.Result check Int)
instance (NFShape f) => NFData (Shape f) where
rnf :: Shape f -> ()
rnf = Shape f -> ()
forall (f :: * -> *). NFShape f => Shape f -> ()
rnfShape
instance (EqShape f) => Eq (Shape f) where
== :: Shape f -> Shape f -> Bool
(==) = Shape f -> Shape f -> Bool
forall (f :: * -> *). EqShape f => Shape f -> Shape f -> Bool
eqShape
instance (C f) => Shape.C (Shape f) where
size :: Shape f -> Int
size = Shape f -> Int
forall (f :: * -> *). C f => Shape f -> Int
shapeSize
instance (Indexed f) => Shape.Indexed (Shape f) where
type Index (Shape f) = Index f
indices :: Shape f -> [Index (Shape f)]
indices = Shape f -> [Index (Shape f)]
forall (f :: * -> *). Indexed f => Shape f -> [Index f]
indices
unifiedSizeOffset :: Shape f -> (Int, Index (Shape f) -> Result check Int)
unifiedSizeOffset = Shape f -> (Int, Index (Shape f) -> Result check Int)
forall (f :: * -> *) check.
(Indexed f, Checking check) =>
Shape f -> (Int, Index f -> Result check Int)
unifiedSizeOffset
instance C [] where
data Shape [] = ShapeList Int
deriving (Int -> Shape [] -> ShowS
[Shape []] -> ShowS
Shape [] -> String
(Int -> Shape [] -> ShowS)
-> (Shape [] -> String) -> ([Shape []] -> ShowS) -> Show (Shape [])
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape []] -> ShowS
$cshowList :: [Shape []] -> ShowS
show :: Shape [] -> String
$cshow :: Shape [] -> String
showsPrec :: Int -> Shape [] -> ShowS
$cshowsPrec :: Int -> Shape [] -> ShowS
Show)
shapeSize :: Shape [] -> Int
shapeSize (ShapeList n) = Int
n
toShape :: [a] -> Shape []
toShape = Int -> Shape []
ShapeList (Int -> Shape []) -> ([a] -> Int) -> [a] -> Shape []
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
fromList :: Shape [] -> [a] -> [a]
fromList Shape []
_ = [a] -> [a]
forall a. a -> a
id
instance EqShape [] where
eqShape :: Shape [] -> Shape [] -> Bool
eqShape (ShapeList n) (ShapeList m) = Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
m
instance NFShape [] where
rnfShape :: Shape [] -> ()
rnfShape (ShapeList n) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n
instance Indexed [] where
type Index [] = Int
indices :: Shape [] -> [Index []]
indices (ShapeList len) = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
len ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0
unifiedSizeOffset :: Shape [] -> (Int, Index [] -> Result check Int)
unifiedSizeOffset (ShapeList len) =
(Int
len, \Index []
ix -> do
String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
Shape.assert String
"Shape.Container.[]: array index too small" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ Int
Index []
ixInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0
String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
Shape.assert String
"Shape.Container.[]: array index too big" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ Int
Index []
ixInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
len
Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
Index []
ix)
instance (C f) => C (NonEmpty.T f) where
data Shape (NonEmpty.T f) = ShapeNonEmpty (Shape f)
shapeSize :: Shape (T f) -> Int
shapeSize (ShapeNonEmpty c) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Shape f -> Int
forall (f :: * -> *). C f => Shape f -> Int
shapeSize Shape f
c
toShape :: T f a -> Shape (T f)
toShape = Shape f -> Shape (T f)
forall (f :: * -> *). Shape f -> Shape (T f)
ShapeNonEmpty (Shape f -> Shape (T f))
-> (T f a -> Shape f) -> T f a -> Shape (T f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Shape f
forall (f :: * -> *) a. C f => f a -> Shape f
toShape (f a -> Shape f) -> (T f a -> f a) -> T f a -> Shape f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T f a -> f a
forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail
fromList :: Shape (T f) -> [a] -> T f a
fromList (ShapeNonEmpty c) [a]
xt =
case [a]
xt of
[] -> String -> T f a
forall a. HasCallStack => String -> a
error String
"ShapeNonEmpty: empty list"
a
x:[a]
xs -> a -> f a -> T f a
forall a (f :: * -> *). a -> f a -> T f a
NonEmpty.cons a
x (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ Shape f -> [a] -> f a
forall (f :: * -> *) a. C f => Shape f -> [a] -> f a
fromList Shape f
c [a]
xs
instance (EqShape f) => EqShape (NonEmpty.T f) where
eqShape :: Shape (T f) -> Shape (T f) -> Bool
eqShape (ShapeNonEmpty a) (ShapeNonEmpty b) = Shape f
aShape f -> Shape f -> Bool
forall a. Eq a => a -> a -> Bool
==Shape f
b
instance (NFShape f) => NFShape (NonEmpty.T f) where
rnfShape :: Shape (T f) -> ()
rnfShape (ShapeNonEmpty c) = Shape f -> ()
forall (f :: * -> *). NFShape f => Shape f -> ()
rnfShape Shape f
c
instance (C f) => Indexed (NonEmpty.T f) where
type Index (NonEmpty.T f) = Int
indices :: Shape (T f) -> [Index (T f)]
indices Shape (T f)
shape = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Shape (T f) -> Int
forall (f :: * -> *). C f => Shape f -> Int
shapeSize Shape (T f)
shape) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0
unifiedSizeOffset :: Shape (T f) -> (Int, Index (T f) -> Result check Int)
unifiedSizeOffset Shape (T f)
shape =
let len :: Int
len = Shape (T f) -> Int
forall (f :: * -> *). C f => Shape f -> Int
shapeSize Shape (T f)
shape in
(Int
len, \Index (T f)
ix -> do
String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
Shape.assert String
"Shape.Container.NonEmpty: array index too small" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ Int
Index (T f)
ixInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0
String -> Bool -> Result check ()
forall check. Checking check => String -> Bool -> Result check ()
Shape.assert String
"Shape.Container.NonEmpty: array index too big" (Bool -> Result check ()) -> Bool -> Result check ()
forall a b. (a -> b) -> a -> b
$ Int
Index (T f)
ixInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
len
Int -> Result check Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
Index (T f)
ix)
instance C Empty.T where
data Shape Empty.T = ShapeEmpty
deriving (Int -> Shape T -> ShowS
[Shape T] -> ShowS
Shape T -> String
(Int -> Shape T -> ShowS)
-> (Shape T -> String) -> ([Shape T] -> ShowS) -> Show (Shape T)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape T] -> ShowS
$cshowList :: [Shape T] -> ShowS
show :: Shape T -> String
$cshow :: Shape T -> String
showsPrec :: Int -> Shape T -> ShowS
$cshowsPrec :: Int -> Shape T -> ShowS
Show)
shapeSize :: Shape T -> Int
shapeSize Shape T
ShapeEmpty = Int
0
toShape :: T a -> Shape T
toShape T a
Empty.Cons = Shape T
ShapeEmpty
fromList :: Shape T -> [a] -> T a
fromList Shape T
ShapeEmpty [a]
xs =
case [a]
xs of
[] -> T a
forall a. T a
Empty.Cons
[a]
_ -> String -> T a
forall a. HasCallStack => String -> a
error String
"ShapeEmpty: not empty"
instance EqShape Empty.T where
eqShape :: Shape T -> Shape T -> Bool
eqShape Shape T
ShapeEmpty Shape T
ShapeEmpty = Bool
True
instance NFShape Empty.T where
rnfShape :: Shape T -> ()
rnfShape Shape T
ShapeEmpty = ()
instance (Ord k) => C (Map k) where
data Shape (Map k) = ShapeMap (Set k)
deriving (Int -> Shape (Map k) -> ShowS
[Shape (Map k)] -> ShowS
Shape (Map k) -> String
(Int -> Shape (Map k) -> ShowS)
-> (Shape (Map k) -> String)
-> ([Shape (Map k)] -> ShowS)
-> Show (Shape (Map k))
forall k. Show k => Int -> Shape (Map k) -> ShowS
forall k. Show k => [Shape (Map k)] -> ShowS
forall k. Show k => Shape (Map k) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape (Map k)] -> ShowS
$cshowList :: forall k. Show k => [Shape (Map k)] -> ShowS
show :: Shape (Map k) -> String
$cshow :: forall k. Show k => Shape (Map k) -> String
showsPrec :: Int -> Shape (Map k) -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Shape (Map k) -> ShowS
Show)
shapeSize :: Shape (Map k) -> Int
shapeSize (ShapeMap set) = Set k -> Int
forall a. Set a -> Int
Set.size Set k
set
toShape :: Map k a -> Shape (Map k)
toShape = Set k -> Shape (Map k)
forall k. Set k -> Shape (Map k)
ShapeMap (Set k -> Shape (Map k))
-> (Map k a -> Set k) -> Map k a -> Shape (Map k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet
fromList :: Shape (Map k) -> [a] -> Map k a
fromList (ShapeMap set) = [(k, a)] -> Map k a
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(k, a)] -> Map k a) -> ([a] -> [(k, a)]) -> [a] -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [a] -> [(k, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set k -> [k]
forall a. Set a -> [a]
Set.toAscList Set k
set)
instance (Ord k) => EqShape (Map k) where
eqShape :: Shape (Map k) -> Shape (Map k) -> Bool
eqShape (ShapeMap set0) (ShapeMap set1) = Set k
set0Set k -> Set k -> Bool
forall a. Eq a => a -> a -> Bool
==Set k
set1
instance (NFData k, Ord k) => NFShape (Map k) where
rnfShape :: Shape (Map k) -> ()
rnfShape (ShapeMap set) = Set k -> ()
forall a. NFData a => a -> ()
rnf Set k
set
instance (Ord k) => Indexed (Map k) where
type Index (Map k) = k
indices :: Shape (Map k) -> [Index (Map k)]
indices (ShapeMap set) = Set k -> [k]
forall a. Set a -> [a]
Set.toAscList Set k
set
unifiedSizeOffset :: Shape (Map k) -> (Int, Index (Map k) -> Result check Int)
unifiedSizeOffset (ShapeMap set) = Set k -> (Int, Index (Set k) -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset Set k
set
instance (Ord k) => C (NonEmptyMap.T k) where
data Shape (NonEmptyMap.T k) = ShapeNonEmptyMap (NonEmptySet.T k)
deriving (Int -> Shape (T k) -> ShowS
[Shape (T k)] -> ShowS
Shape (T k) -> String
(Int -> Shape (T k) -> ShowS)
-> (Shape (T k) -> String)
-> ([Shape (T k)] -> ShowS)
-> Show (Shape (T k))
forall k. Show k => Int -> Shape (T k) -> ShowS
forall k. Show k => [Shape (T k)] -> ShowS
forall k. Show k => Shape (T k) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape (T k)] -> ShowS
$cshowList :: forall k. Show k => [Shape (T k)] -> ShowS
show :: Shape (T k) -> String
$cshow :: forall k. Show k => Shape (T k) -> String
showsPrec :: Int -> Shape (T k) -> ShowS
$cshowsPrec :: forall k. Show k => Int -> Shape (T k) -> ShowS
Show)
shapeSize :: Shape (T k) -> Int
shapeSize (ShapeNonEmptyMap set) = T k -> Int
forall a. T a -> Int
NonEmptySet.size T k
set
toShape :: T k a -> Shape (T k)
toShape = T k -> Shape (T k)
forall k. T k -> Shape (T k)
ShapeNonEmptyMap (T k -> Shape (T k)) -> (T k a -> T k) -> T k a -> Shape (T k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T k a -> T k
forall k a. Ord k => T k a -> T k
NonEmptyMap.keysSet
fromList :: Shape (T k) -> [a] -> T k a
fromList (ShapeNonEmptyMap set) =
T [] (k, a) -> T k a
forall k a. Ord k => T [] (k, a) -> T k a
NonEmptyMap.fromAscList (T [] (k, a) -> T k a) -> ([a] -> T [] (k, a)) -> [a] -> T k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T [] k -> T [] a -> T [] (k, a)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
NonEmptyC.zip (T k -> T [] k
forall a. T a -> T [] a
NonEmptySet.toAscList T k
set) (T [] a -> T [] (k, a)) -> ([a] -> T [] a) -> [a] -> T [] (k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T [] a -> Maybe (T [] a) -> T [] a
forall a. a -> Maybe a -> a
fromMaybe (String -> T [] a
forall a. HasCallStack => String -> a
error String
"ShapeNonEmptyMap: empty list") (Maybe (T [] a) -> T [] a)
-> ([a] -> Maybe (T [] a)) -> [a] -> T [] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (T [] a)
forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a)
NonEmpty.fetch
instance (Ord k) => EqShape (NonEmptyMap.T k) where
eqShape :: Shape (T k) -> Shape (T k) -> Bool
eqShape (ShapeNonEmptyMap set0) (ShapeNonEmptyMap set1) = T k
set0T k -> T k -> Bool
forall a. Eq a => a -> a -> Bool
==T k
set1
instance (NFData k, Ord k) => NFShape (NonEmptyMap.T k) where
rnfShape :: Shape (T k) -> ()
rnfShape (ShapeNonEmptyMap set) = T k -> ()
forall a. NFData a => a -> ()
rnf T k
set
instance (Ord k) => Indexed (NonEmptyMap.T k) where
type Index (NonEmptyMap.T k) = k
indices :: Shape (T k) -> [Index (T k)]
indices (ShapeNonEmptyMap set) =
T [] k -> [k]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten (T [] k -> [k]) -> T [] k -> [k]
forall a b. (a -> b) -> a -> b
$ T k -> T [] k
forall a. T a -> T [] a
NonEmptySet.toAscList T k
set
unifiedSizeOffset :: Shape (T k) -> (Int, Index (T k) -> Result check Int)
unifiedSizeOffset (ShapeNonEmptyMap set) =
Set k -> (Int, Index (Set k) -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset (T k -> Set k
forall a. Ord a => T a -> Set a
NonEmptySet.flatten T k
set)