{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module PDF.Box (
      Box(..)
    , I(..)
    , (.@)
    , at
    , edit
    , forAll
    , modifyAt
  ) where

import Control.Monad.Fail (MonadFail(..))
import Control.Monad.State (MonadState(..))
import Data.Map (Map)
import qualified Data.Map as Map (insert, lookup, member)
import Prelude hiding (fail)

data I = I Int

class Monad m => Box m i a b | m a i -> b where
  r :: i -> a -> m b
  w :: i -> a -> b -> m a

edit :: Box m i a b => i -> (b -> m b) -> a -> m a
edit i f a =
  r i a >>= f >>= w i a

at :: (MonadState a m, Box m i a b) => i -> (b -> m c) -> m c
at i f = get >>= r i >>= f

modifyAt :: (MonadState a m, Box m i a b) => i -> (b -> m b) -> m ()
modifyAt i f = get >>= edit i f >>= put

forAll :: (MonadState a m, Box m i a (t b)) => i -> (b -> m ()) -> m ()
forAll = undefined

instance (Box m i a b, Box m j b c) => Box m (i, j) a c where
  r (i, j) a = r i a >>= r j
  w (i, j) a c = edit i (flip (w j) c) a

instance MonadFail m => Box m I [a] a where
  r (I i) = getAt i
    where
      getAt _ [] = fail $ "Index out of bounds " ++ show i
      getAt 0 (x:_) = return x
      getAt k (_:xs) = getAt (k+1) xs
  w (I i) l newX = setAt i l
    where
      setAt _ [] = fail $ "Index out of bounds " ++ show i
      setAt 0 (_:xs) = return (newX:xs)
      setAt k (x:xs) = (x:)<$>(setAt (k-1) xs)

instance (Ord k, MonadFail m) => Box m k (Map k a) a where
  r k = maybe (fail "Unknown key") return . Map.lookup k
  w k aMap a
    | Map.member k aMap =
        return $ Map.insert k a aMap
    | otherwise = fail "Unknown key"

infixr 6 .@
(.@) :: a -> b -> (a, b)
(.@) = (,)