{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, FlexibleContexts, TypeOperators #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.InOut
-- Copyright   :  (C) 2013 Hugo Pacheco
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Hugo Pacheco <hpacheco@nii.ac.jp>
-- Stability   :  provisional
--
-- Generic sums of products representation for algebraic data types
-- 
--
--
----------------------------------------------------------------------------
module GHC.InOut where

import GHC.Generics

class (Generic a,ToFromRep (Rep a)) => InOut a where
  inn :: F a -> a
  out :: a -> F a
  
type family Flatten (f :: * -> *) :: *
type F a = Flatten (Rep a)

class ToFromRep (f :: * -> *) where
  fromRep :: f x -> Flatten f
  toRep :: Flatten f -> f x

type instance Flatten U1 = ()
type instance Flatten (K1 i c) = c
type instance Flatten (M1 i c f) = Flatten f
type instance Flatten (f :+: g) = Either (Flatten f) (Flatten g)
type instance Flatten (f :*: g) = (Flatten f,Flatten g)

instance ToFromRep U1 where
  fromRep U1 = ()
  toRep () = U1
instance ToFromRep (K1 i c) where
  fromRep (K1 c) = c
  toRep c = K1 c
instance ToFromRep f => ToFromRep (M1 i c f) where
  fromRep (M1 f) = fromRep f
  toRep x = M1 $ toRep x
instance (ToFromRep f,ToFromRep g) => ToFromRep (f :+: g) where
  fromRep (L1 f) = Left (fromRep f)
  fromRep (R1 g) = Right (fromRep g)
  toRep (Left x) = L1 (toRep x)
  toRep (Right y) = R1 (toRep y)
instance (ToFromRep f,ToFromRep g) => ToFromRep (f :*: g) where
  fromRep (f :*: g) = (fromRep f,fromRep g)
  toRep (f,g) = (toRep f :*: toRep g)

instance (Generic a,ToFromRep (Rep a)) => InOut a where
  inn = to . toRep
  out = fromRep . from

--instance InOut [a] where
--  inn s = either (\() -> []) (\(x,xs) -> x:xs) s
--  out l = case l of { [] -> Left (); (x:xs) -> Right (x,xs) }