{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Apecs.Experimental.Stores
( Pushdown(..), Stack(..)
) where
import Control.Monad.Reader
import Data.Proxy
import Data.Semigroup
import Apecs.Components (MaybeStore (..))
import Apecs.Core
newtype Pushdown s c = Pushdown (s (Stack c))
newtype Stack c = Stack {forall c. Stack c -> [c]
getStack :: [c]} deriving (Stack c -> Stack c -> Bool
forall c. Eq c => Stack c -> Stack c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stack c -> Stack c -> Bool
$c/= :: forall c. Eq c => Stack c -> Stack c -> Bool
== :: Stack c -> Stack c -> Bool
$c== :: forall c. Eq c => Stack c -> Stack c -> Bool
Eq, Int -> Stack c -> ShowS
forall c. Show c => Int -> Stack c -> ShowS
forall c. Show c => [Stack c] -> ShowS
forall c. Show c => Stack c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack c] -> ShowS
$cshowList :: forall c. Show c => [Stack c] -> ShowS
show :: Stack c -> String
$cshow :: forall c. Show c => Stack c -> String
showsPrec :: Int -> Stack c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> Stack c -> ShowS
Show, forall a b. a -> Stack b -> Stack a
forall a b. (a -> b) -> Stack a -> Stack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Stack b -> Stack a
$c<$ :: forall a b. a -> Stack b -> Stack a
fmap :: forall a b. (a -> b) -> Stack a -> Stack b
$cfmap :: forall a b. (a -> b) -> Stack a -> Stack b
Functor, Functor Stack
forall a. a -> Stack a
forall a b. Stack a -> Stack b -> Stack a
forall a b. Stack a -> Stack b -> Stack b
forall a b. Stack (a -> b) -> Stack a -> Stack b
forall a b c. (a -> b -> c) -> Stack a -> Stack b -> Stack c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Stack a -> Stack b -> Stack a
$c<* :: forall a b. Stack a -> Stack b -> Stack a
*> :: forall a b. Stack a -> Stack b -> Stack b
$c*> :: forall a b. Stack a -> Stack b -> Stack b
liftA2 :: forall a b c. (a -> b -> c) -> Stack a -> Stack b -> Stack c
$cliftA2 :: forall a b c. (a -> b -> c) -> Stack a -> Stack b -> Stack c
<*> :: forall a b. Stack (a -> b) -> Stack a -> Stack b
$c<*> :: forall a b. Stack (a -> b) -> Stack a -> Stack b
pure :: forall a. a -> Stack a
$cpure :: forall a. a -> Stack a
Applicative, Applicative Stack
forall a. a -> Stack a
forall a b. Stack a -> Stack b -> Stack b
forall a b. Stack a -> (a -> Stack b) -> Stack b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Stack a
$creturn :: forall a. a -> Stack a
>> :: forall a b. Stack a -> Stack b -> Stack b
$c>> :: forall a b. Stack a -> Stack b -> Stack b
>>= :: forall a b. Stack a -> (a -> Stack b) -> Stack b
$c>>= :: forall a b. Stack a -> (a -> Stack b) -> Stack b
Monad, forall a. Eq a => a -> Stack a -> Bool
forall a. Num a => Stack a -> a
forall a. Ord a => Stack a -> a
forall m. Monoid m => Stack m -> m
forall a. Stack a -> Bool
forall a. Stack a -> Int
forall c. Stack c -> [c]
forall a. (a -> a -> a) -> Stack a -> a
forall m a. Monoid m => (a -> m) -> Stack a -> m
forall b a. (b -> a -> b) -> b -> Stack a -> b
forall a b. (a -> b -> b) -> b -> Stack 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
product :: forall a. Num a => Stack a -> a
$cproduct :: forall a. Num a => Stack a -> a
sum :: forall a. Num a => Stack a -> a
$csum :: forall a. Num a => Stack a -> a
minimum :: forall a. Ord a => Stack a -> a
$cminimum :: forall a. Ord a => Stack a -> a
maximum :: forall a. Ord a => Stack a -> a
$cmaximum :: forall a. Ord a => Stack a -> a
elem :: forall a. Eq a => a -> Stack a -> Bool
$celem :: forall a. Eq a => a -> Stack a -> Bool
length :: forall a. Stack a -> Int
$clength :: forall a. Stack a -> Int
null :: forall a. Stack a -> Bool
$cnull :: forall a. Stack a -> Bool
toList :: forall c. Stack c -> [c]
$ctoList :: forall c. Stack c -> [c]
foldl1 :: forall a. (a -> a -> a) -> Stack a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stack a -> a
foldr1 :: forall a. (a -> a -> a) -> Stack a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stack a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Stack a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stack a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Stack a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stack a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Stack a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stack a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Stack a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stack a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Stack a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stack a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Stack a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stack a -> m
fold :: forall m. Monoid m => Stack m -> m
$cfold :: forall m. Monoid m => Stack m -> m
Foldable, Stack c
[Stack c] -> Stack c
Stack c -> Stack c -> Stack c
forall {c}. Semigroup (Stack c)
forall c. Stack c
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall c. [Stack c] -> Stack c
forall c. Stack c -> Stack c -> Stack c
mconcat :: [Stack c] -> Stack c
$cmconcat :: forall c. [Stack c] -> Stack c
mappend :: Stack c -> Stack c -> Stack c
$cmappend :: forall c. Stack c -> Stack c -> Stack c
mempty :: Stack c
$cmempty :: forall c. Stack c
Monoid, NonEmpty (Stack c) -> Stack c
Stack c -> Stack c -> Stack c
forall b. Integral b => b -> Stack c -> Stack c
forall c. NonEmpty (Stack c) -> Stack c
forall c. Stack c -> Stack c -> Stack c
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall c b. Integral b => b -> Stack c -> Stack c
stimes :: forall b. Integral b => b -> Stack c -> Stack c
$cstimes :: forall c b. Integral b => b -> Stack c -> Stack c
sconcat :: NonEmpty (Stack c) -> Stack c
$csconcat :: forall c. NonEmpty (Stack c) -> Stack c
<> :: Stack c -> Stack c -> Stack c
$c<> :: forall c. Stack c -> Stack c -> Stack c
Semigroup)
type instance Elem (Pushdown s c) = c
instance (Functor m, ExplInit m (s (Stack c))) => ExplInit m (Pushdown s c) where
explInit :: m (Pushdown s c)
explInit = forall (s :: * -> *) c. s (Stack c) -> Pushdown s c
Pushdown forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplInit m s => m s
explInit
pattern StackList :: c -> [c] -> Maybe (Stack c)
pattern $bStackList :: forall c. c -> [c] -> Maybe (Stack c)
$mStackList :: forall {r} {c}.
Maybe (Stack c) -> (c -> [c] -> r) -> ((# #) -> r) -> r
StackList x xs = Just (Stack (x:xs))
instance
( Monad m
, ExplGet m (s (Stack c))
, Elem (s (Stack c)) ~ Stack c
) => ExplGet m (Pushdown s c) where
explExists :: Pushdown s c -> Int -> m Bool
explExists (Pushdown s (Stack c)
s) Int
ety = forall {c}. Maybe (Stack c) -> Bool
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet (forall s. s -> MaybeStore s
MaybeStore s (Stack c)
s) Int
ety
where
f :: Maybe (Stack c) -> Bool
f (StackList c
_ [c]
_) = Bool
True
f Maybe (Stack c)
_ = Bool
False
explGet :: Pushdown s c -> Int -> m (Elem (Pushdown s c))
explGet (Pushdown s (Stack c)
s) Int
ety = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Stack c -> [c]
getStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet s (Stack c)
s Int
ety
instance
( Monad m
, ExplGet m (s (Stack c))
, ExplSet m (s (Stack c))
, Elem (s (Stack c)) ~ Stack c
) => ExplSet m (Pushdown s c) where
explSet :: Pushdown s c -> Int -> Elem (Pushdown s c) -> m ()
explSet (Pushdown s (Stack c)
s) Int
ety Elem (Pushdown s c)
c = do
Maybe (Stack c)
ms <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet (forall s. s -> MaybeStore s
MaybeStore s (Stack c)
s) Int
ety
let tail :: Maybe (Stack c) -> [c]
tail (StackList c
_ [c]
cs) = [c]
cs
tail Maybe (Stack c)
_ = []
forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s (Stack c)
s Int
ety (forall c. [c] -> Stack c
Stack (Elem (Pushdown s c)
cforall a. a -> [a] -> [a]
:forall {c}. Maybe (Stack c) -> [c]
tail Maybe (Stack c)
ms))
instance
( Monad m
, ExplGet m (s (Stack c))
, ExplSet m (s (Stack c))
, ExplDestroy m (s (Stack c))
, Elem (s (Stack c)) ~ Stack c
) => ExplDestroy m (Pushdown s c) where
explDestroy :: Pushdown s c -> Int -> m ()
explDestroy (Pushdown s (Stack c)
s) Int
ety = do
Maybe (Stack c)
mscs <- forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet (forall s. s -> MaybeStore s
MaybeStore s (Stack c)
s) Int
ety
case Maybe (Stack c)
mscs of
StackList c
_ [c]
cs' -> forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s (Stack c)
s Int
ety (forall c. [c] -> Stack c
Stack [c]
cs')
Maybe (Stack c)
_ -> forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy s (Stack c)
s Int
ety
instance
( Monad m
, ExplMembers m (s (Stack c))
, Elem (s (Stack c)) ~ Stack c
) => ExplMembers m (Pushdown s c) where
explMembers :: Pushdown s c -> m (Vector Int)
explMembers (Pushdown s (Stack c)
s) = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers s (Stack c)
s
instance (Storage c ~ Pushdown s c, Component c) => Component (Stack c) where
type Storage (Stack c) = StackStore (Storage c)
newtype StackStore s = StackStore s
type instance Elem (StackStore s) = Stack (Elem s)
instance (Storage c ~ Pushdown s c, Has w m c) => Has w m (Stack c) where
getStore :: SystemT w m (Storage (Stack c))
getStore = forall s. s -> StackStore s
StackStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance
( Elem (s (Stack c)) ~ Stack c
, ExplGet m (s (Stack c))
) => ExplGet m (StackStore (Pushdown s c)) where
explExists :: StackStore (Pushdown s c) -> Int -> m Bool
explExists (StackStore Pushdown s c
s) = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists Pushdown s c
s
explGet :: StackStore (Pushdown s c)
-> Int -> m (Elem (StackStore (Pushdown s c)))
explGet (StackStore (Pushdown s (Stack c)
s)) = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m (Elem s)
explGet s (Stack c)
s
instance
( Elem (s (Stack c)) ~ Stack c
, ExplSet m (s (Stack c))
, ExplDestroy m (s (Stack c))
) => ExplSet m (StackStore (Pushdown s c)) where
explSet :: StackStore (Pushdown s c)
-> Int -> Elem (StackStore (Pushdown s c)) -> m ()
explSet (StackStore (Pushdown s (Stack c)
s)) Int
ety (Stack []) = forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy s (Stack c)
s Int
ety
explSet (StackStore (Pushdown s (Stack c)
s)) Int
ety Elem (StackStore (Pushdown s c))
st = forall (m :: * -> *) s. ExplSet m s => s -> Int -> Elem s -> m ()
explSet s (Stack c)
s Int
ety Elem (StackStore (Pushdown s c))
st
instance
( Elem (s (Stack c)) ~ Stack c
, ExplDestroy m (s (Stack c))
) => ExplDestroy m (StackStore (Pushdown s c)) where
explDestroy :: StackStore (Pushdown s c) -> Int -> m ()
explDestroy (StackStore (Pushdown s (Stack c)
s)) = forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy s (Stack c)
s
instance
( Elem (s (Stack c)) ~ Stack c
, ExplMembers m (s (Stack c))
) => ExplMembers m (StackStore (Pushdown s c)) where
explMembers :: StackStore (Pushdown s c) -> m (Vector Int)
explMembers (StackStore (Pushdown s (Stack c)
s)) = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers s (Stack c)
s