module Data.DiscreteSpaceMap (Pos(..), Map(..), modify) where
import Control.Comonad
import Control.Comonad.Store.Class
import Data.Distributive
import Data.Key
import Data.Functor.Bind
import Data.Functor.Rep
import Data.Foldable
import Data.Traversable
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.DiscreteSpaceMap.Internal
data Map p a = Map !p !a (MapD a) deriving Show
modify :: (a -> a) -> Map p a -> Map p a
modify m (Map p a f) = Map p (m a) f
type instance Key (Map p) = p
instance Pos p => Zip (Map p) where
zipWith f = zipWithKey (const f)
instance Pos p => ZipWithKey (Map p) where
zipWithKey f as bs = Map p (f p a b) $ zipWithKeyD f p ca cb
where
Map p b cb = bs
Map _ a ca = seek p as
instance Pos p => ComonadApply (Map p) where
(<@>) = zap
instance Comonad (Map p) where
extract (Map _ a _) = a
extend f z@(Map p _ c) = Map p (f z) $ fmap (\a -> f (Map p a c)) c
instance Pos p => ComonadStore p (Map p) where
pos (Map p _ _) = p
peek tp (Map sp a c) = fst $ gotoD sp tp (a, c)
seek tp (Map sp a c) = let (a', c') = gotoD sp tp (a, c) in Map tp a' c'
seeks f w = seek (f (pos w)) w
instance Pos p => Indexable (Map p) where
index = flip peek
instance Pos p => Lookup (Map p) where
lookup = lookupDefault
instance Pos p => Adjustable (Map p) where
adjust f p z = seek (pos z) . modify f . seek p $ z
instance Pos p => Distributive (Map p) where
distribute (fmap (seek zero) -> m) = Map zero (fmap extract m) (cotraverseD id $ (\(Map _ _ c) -> c) <$> m)
instance Pos p => Representable (Map p) where
type Rep (Map p) = p
tabulate f = Map zero (f zero) (tabulateD f)
index = flip peek
instance Functor (Map p) where
fmap = fmapDefault
instance Pos p => Keyed (Map p) where
mapWithKey = mapWithKeyDefault
instance Foldable (Map p) where
foldMap = foldMapDefault
instance Pos p => FoldableWithKey (Map p) where
foldMapWithKey = foldMapWithKeyDefault
instance Foldable1 (Map p) where
foldMap1 = foldMap1Default
instance Pos p => FoldableWithKey1 (Map p) where
foldMapWithKey1 = foldMapWithKey1Default
instance Traversable (Map p) where
traverse f = unwrapApplicative . traverse1 (WrapApplicative . f)
instance Pos p => TraversableWithKey (Map p) where
traverseWithKey f = unwrapApplicative . traverseWithKey1 (\k a -> WrapApplicative (f k a))
instance Traversable1 (Map p) where
traverse1 f (Map p a c) = Map p <$> f a <.> traverse1 f c
instance Pos p => TraversableWithKey1 (Map p) where
traverseWithKey1 f (Map p a c) = Map p <$> f p a <.> traverseWithKey1D f p c