{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Language.Hasmtlib.Type.ArrayMap where

import Data.Proxy
import qualified Data.Map as Map
import Control.Lens

-- | Class that allows access to a map-like array where any value is either the default value or an overwritten values.
--   Every index has a value by default.
--   Values at indices can be overwritten manually.
--
--   Based on McCarthy`s basic array theory.
--
--   Therefore the following axioms must hold:
--
-- 1. forall A i x: arrSelect (store A i x) == x
--
-- 2. forall A i j x: i /= j ==> (arrSelect (arrStore A i x) j === arrSelect A j)
class ArrayMap f k v where
  asConst'   :: Proxy f -> Proxy k -> v -> f k v
  viewConst  :: f k v -> v
  arrSelect  :: f k v -> k -> v
  arrStore   :: f k v -> k -> v -> f k v

-- | Wrapper for 'asConst'' which hides the 'Proxy'
asConst :: forall f k v. ArrayMap f k v => v -> f k v
asConst :: forall (f :: * -> * -> *) k v. ArrayMap f k v => v -> f k v
asConst = Proxy f -> Proxy k -> v -> f k v
forall (f :: * -> * -> *) k v.
ArrayMap f k v =>
Proxy f -> Proxy k -> v -> f k v
asConst' (forall {k} (t :: k). Proxy t
forall (t :: * -> * -> *). Proxy t
Proxy @f) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @k)

-- | A map-like array with a default constant value and partially overwritten values.
data ConstArray k v = ConstArray
  { forall k v. ConstArray k v -> v
_arrConst :: v
  , forall k v. ConstArray k v -> Map k v
_stored :: Map.Map k v
  } deriving (Int -> ConstArray k v -> ShowS
[ConstArray k v] -> ShowS
ConstArray k v -> String
(Int -> ConstArray k v -> ShowS)
-> (ConstArray k v -> String)
-> ([ConstArray k v] -> ShowS)
-> Show (ConstArray k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show v, Show k) => Int -> ConstArray k v -> ShowS
forall k v. (Show v, Show k) => [ConstArray k v] -> ShowS
forall k v. (Show v, Show k) => ConstArray k v -> String
$cshowsPrec :: forall k v. (Show v, Show k) => Int -> ConstArray k v -> ShowS
showsPrec :: Int -> ConstArray k v -> ShowS
$cshow :: forall k v. (Show v, Show k) => ConstArray k v -> String
show :: ConstArray k v -> String
$cshowList :: forall k v. (Show v, Show k) => [ConstArray k v] -> ShowS
showList :: [ConstArray k v] -> ShowS
Show, ConstArray k v -> ConstArray k v -> Bool
(ConstArray k v -> ConstArray k v -> Bool)
-> (ConstArray k v -> ConstArray k v -> Bool)
-> Eq (ConstArray k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v.
(Eq v, Eq k) =>
ConstArray k v -> ConstArray k v -> Bool
$c== :: forall k v.
(Eq v, Eq k) =>
ConstArray k v -> ConstArray k v -> Bool
== :: ConstArray k v -> ConstArray k v -> Bool
$c/= :: forall k v.
(Eq v, Eq k) =>
ConstArray k v -> ConstArray k v -> Bool
/= :: ConstArray k v -> ConstArray k v -> Bool
Eq, Eq (ConstArray k v)
Eq (ConstArray k v) =>
(ConstArray k v -> ConstArray k v -> Ordering)
-> (ConstArray k v -> ConstArray k v -> Bool)
-> (ConstArray k v -> ConstArray k v -> Bool)
-> (ConstArray k v -> ConstArray k v -> Bool)
-> (ConstArray k v -> ConstArray k v -> Bool)
-> (ConstArray k v -> ConstArray k v -> ConstArray k v)
-> (ConstArray k v -> ConstArray k v -> ConstArray k v)
-> Ord (ConstArray k v)
ConstArray k v -> ConstArray k v -> Bool
ConstArray k v -> ConstArray k v -> Ordering
ConstArray k v -> ConstArray k v -> ConstArray k v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord v, Ord k) => Eq (ConstArray k v)
forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Bool
forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Ordering
forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> ConstArray k v
$ccompare :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Ordering
compare :: ConstArray k v -> ConstArray k v -> Ordering
$c< :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Bool
< :: ConstArray k v -> ConstArray k v -> Bool
$c<= :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Bool
<= :: ConstArray k v -> ConstArray k v -> Bool
$c> :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Bool
> :: ConstArray k v -> ConstArray k v -> Bool
$c>= :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> Bool
>= :: ConstArray k v -> ConstArray k v -> Bool
$cmax :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> ConstArray k v
max :: ConstArray k v -> ConstArray k v -> ConstArray k v
$cmin :: forall k v.
(Ord v, Ord k) =>
ConstArray k v -> ConstArray k v -> ConstArray k v
min :: ConstArray k v -> ConstArray k v -> ConstArray k v
Ord, (forall a b. (a -> b) -> ConstArray k a -> ConstArray k b)
-> (forall a b. a -> ConstArray k b -> ConstArray k a)
-> Functor (ConstArray k)
forall a b. a -> ConstArray k b -> ConstArray k a
forall a b. (a -> b) -> ConstArray k a -> ConstArray k b
forall k a b. a -> ConstArray k b -> ConstArray k a
forall k a b. (a -> b) -> ConstArray k a -> ConstArray k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> ConstArray k a -> ConstArray k b
fmap :: forall a b. (a -> b) -> ConstArray k a -> ConstArray k b
$c<$ :: forall k a b. a -> ConstArray k b -> ConstArray k a
<$ :: forall a b. a -> ConstArray k b -> ConstArray k a
Functor, (forall m. Monoid m => ConstArray k m -> m)
-> (forall m a. Monoid m => (a -> m) -> ConstArray k a -> m)
-> (forall m a. Monoid m => (a -> m) -> ConstArray k a -> m)
-> (forall a b. (a -> b -> b) -> b -> ConstArray k a -> b)
-> (forall a b. (a -> b -> b) -> b -> ConstArray k a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConstArray k a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConstArray k a -> b)
-> (forall a. (a -> a -> a) -> ConstArray k a -> a)
-> (forall a. (a -> a -> a) -> ConstArray k a -> a)
-> (forall a. ConstArray k a -> [a])
-> (forall a. ConstArray k a -> Bool)
-> (forall a. ConstArray k a -> Int)
-> (forall a. Eq a => a -> ConstArray k a -> Bool)
-> (forall a. Ord a => ConstArray k a -> a)
-> (forall a. Ord a => ConstArray k a -> a)
-> (forall a. Num a => ConstArray k a -> a)
-> (forall a. Num a => ConstArray k a -> a)
-> Foldable (ConstArray k)
forall a. Eq a => a -> ConstArray k a -> Bool
forall a. Num a => ConstArray k a -> a
forall a. Ord a => ConstArray k a -> a
forall m. Monoid m => ConstArray k m -> m
forall a. ConstArray k a -> Bool
forall a. ConstArray k a -> Int
forall a. ConstArray k a -> [a]
forall a. (a -> a -> a) -> ConstArray k a -> a
forall k a. Eq a => a -> ConstArray k a -> Bool
forall k a. Num a => ConstArray k a -> a
forall k a. Ord a => ConstArray k a -> a
forall m a. Monoid m => (a -> m) -> ConstArray k a -> m
forall k m. Monoid m => ConstArray k m -> m
forall k a. ConstArray k a -> Bool
forall k a. ConstArray k a -> Int
forall k a. ConstArray k a -> [a]
forall b a. (b -> a -> b) -> b -> ConstArray k a -> b
forall a b. (a -> b -> b) -> b -> ConstArray k a -> b
forall k a. (a -> a -> a) -> ConstArray k a -> a
forall k m a. Monoid m => (a -> m) -> ConstArray k a -> m
forall k b a. (b -> a -> b) -> b -> ConstArray k a -> b
forall k a b. (a -> b -> b) -> b -> ConstArray k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k m. Monoid m => ConstArray k m -> m
fold :: forall m. Monoid m => ConstArray k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> ConstArray k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ConstArray k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> ConstArray k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ConstArray k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> ConstArray k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ConstArray k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> ConstArray k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ConstArray k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> ConstArray k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ConstArray k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> ConstArray k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ConstArray k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> ConstArray k a -> a
foldr1 :: forall a. (a -> a -> a) -> ConstArray k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> ConstArray k a -> a
foldl1 :: forall a. (a -> a -> a) -> ConstArray k a -> a
$ctoList :: forall k a. ConstArray k a -> [a]
toList :: forall a. ConstArray k a -> [a]
$cnull :: forall k a. ConstArray k a -> Bool
null :: forall a. ConstArray k a -> Bool
$clength :: forall k a. ConstArray k a -> Int
length :: forall a. ConstArray k a -> Int
$celem :: forall k a. Eq a => a -> ConstArray k a -> Bool
elem :: forall a. Eq a => a -> ConstArray k a -> Bool
$cmaximum :: forall k a. Ord a => ConstArray k a -> a
maximum :: forall a. Ord a => ConstArray k a -> a
$cminimum :: forall k a. Ord a => ConstArray k a -> a
minimum :: forall a. Ord a => ConstArray k a -> a
$csum :: forall k a. Num a => ConstArray k a -> a
sum :: forall a. Num a => ConstArray k a -> a
$cproduct :: forall k a. Num a => ConstArray k a -> a
product :: forall a. Num a => ConstArray k a -> a
Foldable, Functor (ConstArray k)
Foldable (ConstArray k)
(Functor (ConstArray k), Foldable (ConstArray k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ConstArray k a -> f (ConstArray k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ConstArray k (f a) -> f (ConstArray k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConstArray k a -> m (ConstArray k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ConstArray k (m a) -> m (ConstArray k a))
-> Traversable (ConstArray k)
forall k. Functor (ConstArray k)
forall k. Foldable (ConstArray k)
forall k (m :: * -> *) a.
Monad m =>
ConstArray k (m a) -> m (ConstArray k a)
forall k (f :: * -> *) a.
Applicative f =>
ConstArray k (f a) -> f (ConstArray k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConstArray k a -> m (ConstArray k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConstArray k a -> f (ConstArray k b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ConstArray k (m a) -> m (ConstArray k a)
forall (f :: * -> *) a.
Applicative f =>
ConstArray k (f a) -> f (ConstArray k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConstArray k a -> m (ConstArray k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConstArray k a -> f (ConstArray k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConstArray k a -> f (ConstArray k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConstArray k a -> f (ConstArray k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
ConstArray k (f a) -> f (ConstArray k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ConstArray k (f a) -> f (ConstArray k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConstArray k a -> m (ConstArray k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConstArray k a -> m (ConstArray k b)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
ConstArray k (m a) -> m (ConstArray k a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ConstArray k (m a) -> m (ConstArray k a)
Traversable)
$(makeLenses ''ConstArray)

instance Ord k => ArrayMap ConstArray k v where
  asConst' :: Proxy ConstArray -> Proxy k -> v -> ConstArray k v
asConst' Proxy ConstArray
_ Proxy k
_ v
x = v -> Map k v -> ConstArray k v
forall k v. v -> Map k v -> ConstArray k v
ConstArray v
x Map k v
forall k a. Map k a
Map.empty
  viewConst :: ConstArray k v -> v
viewConst ConstArray k v
arr = ConstArray k v
arrConstArray k v -> Getting v (ConstArray k v) v -> v
forall s a. s -> Getting a s a -> a
^.Getting v (ConstArray k v) v
forall k v (f :: * -> *).
Functor f =>
(v -> f v) -> ConstArray k v -> f (ConstArray k v)
arrConst
  arrSelect :: ConstArray k v -> k -> v
arrSelect ConstArray k v
arr k
i = case k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
i (ConstArray k v
arrConstArray k v
-> Getting (Map k v) (ConstArray k v) (Map k v) -> Map k v
forall s a. s -> Getting a s a -> a
^.Getting (Map k v) (ConstArray k v) (Map k v)
forall k v k (f :: * -> *).
Functor f =>
(Map k v -> f (Map k v)) -> ConstArray k v -> f (ConstArray k v)
stored) of
    Maybe v
Nothing -> ConstArray k v -> v
forall (f :: * -> * -> *) k v. ArrayMap f k v => f k v -> v
viewConst ConstArray k v
arr
    Just v
x  -> v
x
  arrStore :: ConstArray k v -> k -> v -> ConstArray k v
arrStore ConstArray k v
arr k
i v
x = ConstArray k v
arr ConstArray k v
-> (ConstArray k v -> ConstArray k v) -> ConstArray k v
forall a b. a -> (a -> b) -> b
& (Map k v -> Identity (Map k v))
-> ConstArray k v -> Identity (ConstArray k v)
forall k v k (f :: * -> *).
Functor f =>
(Map k v -> f (Map k v)) -> ConstArray k v -> f (ConstArray k v)
stored ((Map k v -> Identity (Map k v))
 -> ConstArray k v -> Identity (ConstArray k v))
-> (Map k v -> Map k v) -> ConstArray k v -> ConstArray k v
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
i v
x