Ext.hs

module Data.Ext where

import Control.Applicative
import Control.Lens
import Data.Semigroup

--------------------------------------------------------------------------------

data Ext extra core = core :+ extra deriving (Show,Read,Eq,Ord)

instance Functor (Ext e) where
  fmap f (c :+ e) = f c :+ e

instance Monoid e => Applicative (Ext e) where
  pure x = x :+ mempty
  -- | This implementation ignores any extra values f may have
  (f :+ _) <*> (c :+ce) = f c :+ ce

instance (Semigroup core, Semigroup extra) => Semigroup (Ext extra core) where
  (c :+ e) <> (c' :+ e') = c <> c' :+ e <> e'


type core :+ extra = Ext extra core
infixr 1 :+

_core :: (core :+ extra) -> core
_core (c :+ _) = c

_extra :: (core :+ extra) -> extra
_extra (_ :+ e) = e

core :: Lens (core :+ extra) (core' :+ extra) core core'
core = lens _core (\(_ :+ e) c -> (c :+ e))

extra :: Lens (core :+ extra) (core :+ extra') extra extra'
extra = lens _extra (\(c :+ _) e -> (c :+ e))


only   :: a -> a :+ ()
only x = x :+ ()