Context.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveFunctor #-}

module Data.Functor.Context (
        Ctxt(..),
        mapCtxt,
        extractCtxt,
  ) where

import Control.Comonad
import Control.Applicative
import Control.Lens.Wrapped
import Control.Lens.Iso

-- TODO use newtype and derivice Functor, Comonad etc
newtype Ctxt a = Ctxt { getCtxt :: (Maybe a, a, Maybe a) }
  deriving (Functor)

instance Wrapped (Ctxt a) where
  type Unwrapped (Ctxt a) = (Maybe a, a, Maybe a)
  _Wrapped' = iso getCtxt Ctxt

instance Rewrapped (Ctxt a) (Ctxt b)

instance Applicative Ctxt where
  pure x = Ctxt (Nothing, x, Nothing)
  Ctxt (b,x,a) <*> Ctxt (b',x',a') = Ctxt (b <*> b', x x', a <*> a')
  
-- instance Comonad Ctxt where
  -- extract (Ctxt (b,x,a)) = x

  -- duplicate (Ctxt (Nothing,x,Nothing)) = Ctxt (Nothing, Ctxt (Nothing, x, Nothing), Nothing)
  -- duplicate (Ctxt (Just b,x,Nothing)) = Ctxt (Ctxt Just b, Ctxt (Just b, x, Nothing), Nothing)
  -- duplicate (Ctxt (Nothing,x,Just a)) = Ctxt (Nothing, Ctxt (Nothing, x, Just a), Just a)
  -- duplicate (Ctxt (Just b,x,Just a)) = Ctxt (b, Ctxt (b, x, Just a), Just a)

mapCtxt :: (a -> b) -> Ctxt a -> Ctxt b
mapCtxt = fmap

extractCtxt :: Ctxt a -> a
extractCtxt (Ctxt (_,x,_)) = x