{-# LANGUAGE TypeFamilies #-}
{- |
This module provides an array shape type,
that allows to store elements from a container
while preserving the container structure.
-}
module Data.Array.Comfort.Container (
   C(..), EqShape(..), NFShape(..),
   ) 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 qualified Data.Complex as Complex
import Data.Map (Map)
import Data.Set (Set)
import Data.Foldable (Foldable)
import Data.Maybe (fromMaybe)
-- import Data.Complex (Complex((:+)))



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


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
   uncheckedSize :: Shape f -> Int
uncheckedSize = Shape f -> Int
forall (f :: * -> *). C f => Shape f -> Int
shapeSize


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 Foldable only available since GHC-8.0. :-(
Could be circumvented by Data.Orphans
but that one also pulls in lots of dangerous instances.

instance C Complex where
   data Shape Complex = ShapeComplex
   shapeSize ShapeComplex = 2
   toShape (_:+_) = ShapeComplex
   fromList ShapeComplex xs =
      case xs of
         [r,i] -> r Complex.:+ i
         _ -> error "ShapeComplex: not two elements"

instance EqShape Complex where
   eqShape ShapeComplex ShapeComplex = True

instance NFShape Complex where
   rnfShape ShapeComplex = ()
-}


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 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) => 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