packages feed

lub-0.0.0: src/Data/AssocRepr.hs

{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.AssocRepr
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Compute least upper bounds (lub / join) of two values
-- 
-- This version uses associated types for HasRepr
----------------------------------------------------------------------

module Data.AssocRepr (HasRepr(..), onRepr, onRepr2) where

-- Reprs.  TODO: find & use a simple, standard generic programming framework.

class HasRepr t where
  type Repr t
  repr   :: t -> Repr t
  unrepr :: Repr t -> t

-- | Apply a binary function on a repr
onRepr :: (HasRepr a, HasRepr b) =>
          (Repr a -> Repr b)
       -> (a -> b)
onRepr h = unrepr . h . repr

-- | Apply a binary function on a repr
onRepr2 :: (HasRepr a, HasRepr b, HasRepr c) =>
           (Repr a -> Repr b -> Repr c)
        -> (a -> b -> c)
onRepr2 op a b = unrepr (repr a `op` repr b)


-- Repr instances

instance HasRepr (Maybe a) where
  type Repr (Maybe a) = Either () a
  
  repr   Nothing      = (Left ())
  repr   (Just a)     = (Right a)
  
  unrepr (Left ())    = Nothing
  unrepr (Right a)    = (Just a)
  

instance HasRepr [a] where
  type Repr [a]         = Either () (a,[a])
  
  repr   []             = (Left  ())
  repr   (a:as)         = (Right (a,as))
  
  unrepr (Left  ())     = []
  unrepr (Right (a,as)) = (a:as)

-- ...