{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances
           , FunctionalDependencies
  #-}
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Repr
-- 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.Repr {-# DEPRECATED "Use generics instead" #-}
  (HasRepr(..), onRepr, onRepr2) where

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

-- | A data type representation, in terms of standard data types.
-- Requires that @'unrepr' . 'repr' == 'id'@.
class HasRepr t r | t -> r where
  repr   :: t -> r  -- ^  to  representation
  unrepr :: r -> t  -- ^ from representation

-- | Apply a binary function on a repr
onRepr :: (HasRepr a ra, HasRepr b rb) =>
          (ra -> rb) -> (a -> b)
onRepr :: (ra -> rb) -> a -> b
onRepr ra -> rb
h = rb -> b
forall t r. HasRepr t r => r -> t
unrepr (rb -> b) -> (a -> rb) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ra -> rb
h (ra -> rb) -> (a -> ra) -> a -> rb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ra
forall t r. HasRepr t r => t -> r
repr

-- | Apply a binary function on a repr
onRepr2 :: (HasRepr a ra, HasRepr b rb, HasRepr c rc) =>
           (ra -> rb -> rc) -> (a -> b -> c)
onRepr2 :: (ra -> rb -> rc) -> a -> b -> c
onRepr2 ra -> rb -> rc
h a
a b
b = rc -> c
forall t r. HasRepr t r => r -> t
unrepr (ra -> rb -> rc
h (a -> ra
forall t r. HasRepr t r => t -> r
repr a
a) (b -> rb
forall t r. HasRepr t r => t -> r
repr b
b))

-- Equivalently:
-- 
--   onRepr2 h a = unrepr . h (repr a) . repr
--   
--   onRepr2 h a = onRepr (h (repr a))
--   
--   onRepr2 h = onRepr . h . repr



-- Some HasRepr instances

instance HasRepr (Maybe a) (Either () a) where
  repr :: Maybe a -> Either () a
repr   Maybe a
Nothing   = (() -> Either () a
forall a b. a -> Either a b
Left ())
  repr   (Just a
a)  = (a -> Either () a
forall a b. b -> Either a b
Right a
a)
  
  unrepr :: Either () a -> Maybe a
unrepr (Left ()) = Maybe a
forall a. Maybe a
Nothing
  unrepr (Right a
a) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  

instance HasRepr [a] (Either () (a,[a])) where
  repr :: [a] -> Either () (a, [a])
repr   []             = (() -> Either () (a, [a])
forall a b. a -> Either a b
Left  ())
  repr   (a
a:[a]
as)         = ((a, [a]) -> Either () (a, [a])
forall a b. b -> Either a b
Right (a
a,[a]
as))
  
  unrepr :: Either () (a, [a]) -> [a]
unrepr (Left  ())     = []
  unrepr (Right (a
a,[a]
as)) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)

-- ...