content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE TypeFamilies, TypeOperators #-}
  {-# LANGUAGE FlexibleInstances, EmptyCase, LambdaCase #-}
  {-# LANGUAGE ScopedTypeVariables #-} -- experiment
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE TypeInType #-}
  
  -- -- Experiment
  -- {-# LANGUAGE MagicHash #-}
  
  {-# OPTIONS_GHC -Wall #-}
  
  -- {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP
  -- {-# OPTIONS_GHC -fno-warn-unused-binds   #-} -- TEMP
  
  ----------------------------------------------------------------------
  -- |
  -- Module      :  ConCat.Rep
  -- Copyright   :  (c) 2016 Conal Elliott
  -- 
  -- Maintainer  :  conal@conal.net
  -- Stability   :  experimental
  -- 
  -- Convert to and from standard representations.
  -- TODO: Can I replace HasRep with Generic or Newtype?
  ----------------------------------------------------------------------
  
  module ConCat.Rep (HasRep(..), inAbst,inAbst2, inAbstF1, inRepr,inRepr2) where
  
  import Data.Monoid
  -- import Data.Newtypes.PrettyDouble
  import Control.Applicative (WrappedMonad(..))
  import qualified GHC.Generics as G
  import Data.Complex (Complex(..))
  -- import GHC.TypeLits (KnownNat)
  import Data.Proxy
  
  import Data.Functor.Identity (Identity(..))
  import Control.Monad.Trans.Reader (ReaderT(..))
  import Control.Monad.Trans.Writer (WriterT(..))
  import Control.Monad.Trans.State (StateT(..))
  -- import Data.Finite (Finite,finite,getFinite)
  -- import Data.Finite.Internal (Finite(..))
  
  -- import Data.Void (Void)
  -- TODO: more
  
  -- import ConCat.Complex
  
  -- import GHC.Types (TYPE)
  -- import GHC.Exts (Int(..),Int#)
  
  -- TODO: Eliminate most of the following when I drop these types.
  import ConCat.Misc ((:*),(:+),Parity(..),(<~),bottom)
  
  -- import TypeUnary.TyNat (Z,S)
  -- import TypeUnary.Nat (Nat(..),IsNat(..))
  -- import TypeUnary.Vec (Vec(..))
  
  -- | Convert to and from standard representations. Used for transforming case
  -- expression scrutinees and constructor applications. The 'repr' method should
  -- convert to a standard representation (unit, products, sums), or closer to
  -- such a representation, via another type with a 'HasRep' instance. The 'abst'
  -- method should reveal a constructor so that we can perform the
  -- case-of-known-constructor transformation.
  -- It is very important to give @INLINE@ pragmas for 'repr' and 'abst' definitions.
  
  class HasRep a where
    type Rep a
    repr :: a -> Rep a
    abst :: Rep a -> a
  
  -- -- Identity as @'abst' . 'repr'@.
  -- abstRepr :: HasRep a => a -> a
  -- abstRepr = abst . repr
  
  #define INLINES {-# INLINE repr #-};{-# INLINE abst #-}
  
  instance HasRep (Proxy a) where
    type Rep (Proxy a) = ()
    repr Proxy = ()
    abst () = Proxy
    INLINES
  
  instance HasRep (a,b,c) where
    type Rep (a,b,c) = ((a,b),c)
    repr (a,b,c) = ((a,b),c)
    abst ((a,b),c) = (a,b,c)
    INLINES
  
  instance HasRep (a,b,c,d) where
    type Rep (a,b,c,d) = ((a,b),(c,d))
    repr (a,b,c,d) = ((a,b),(c,d))
    abst ((a,b),(c,d)) = (a,b,c,d)
    INLINES
  
  instance HasRep (a,b,c,d,e) where
    type Rep (a,b,c,d,e) = ((a,b,c,d),e)
    repr (a,b,c,d,e) = ((a,b,c,d),e)
    abst ((a,b,c,d),e) = (a,b,c,d,e)
    INLINES
  
  instance HasRep (a,b,c,d,e,f) where
    type Rep (a,b,c,d,e,f) = ((a,b,c,d),(e,f))
    repr (a,b,c,d,e,f) = ((a,b,c,d),(e,f))
    abst ((a,b,c,d),(e,f)) = (a,b,c,d,e,f)
    INLINES
  
  instance HasRep (a,b,c,d,e,f,g) where
    type Rep (a,b,c,d,e,f,g) = ((a,b,c,d),(e,f,g))
    repr (a,b,c,d,e,f,g) = ((a,b,c,d),(e,f,g))
    abst ((a,b,c,d),(e,f,g)) = (a,b,c,d,e,f,g)
    INLINES
  
  instance HasRep (a,b,c,d,e,f,g,h) where
    type Rep (a,b,c,d,e,f,g,h) = ((a,b,c,d),(e,f,g,h))
    repr (a,b,c,d,e,f,g,h) = ((a,b,c,d),(e,f,g,h))
    abst ((a,b,c,d),(e,f,g,h)) = (a,b,c,d,e,f,g,h)
    INLINES
  
  #if 1
  
  -- I'm now synthesizing HasRep instances for newtypes.
  -- Oh! I still need support for explicit uses.
  
  #define WrapRep(abstT,reprT,con) \
  instance HasRep (abstT) where { type Rep (abstT) = reprT; repr (con a) = a ; abst a = con a }
  
  WrapRep(Sum a,a,Sum)
  -- WrapRep(PrettyDouble,Double,PrettyDouble)
  WrapRep(Product a,a,Product)
  WrapRep(All,Bool,All)
  WrapRep(Any,Bool,Any)
  WrapRep(Dual a,a,Dual)
  WrapRep(Endo a,a->a,Endo)
  WrapRep(WrappedMonad m a,m a,WrapMonad)
  WrapRep(Identity a,a,Identity)
  WrapRep(ReaderT e m a, e -> m a, ReaderT)
  WrapRep(WriterT w m a, m (a,w), WriterT)
  WrapRep(StateT s m a, s -> m (a,s), StateT)
  
  WrapRep(Parity,Bool,Parity)
  
  -- instance KnownNat n => HasRep (Finite n) where
  --   type Rep (Finite n) = Integer
  --   -- abst = finite
  --   -- repr = getFinite
  --   abst n = Finite n
  --   repr (Finite n) = n
  
  -- instance KnownNat n => HasRep (Finite n) where
  --   type Rep (Finite n) = Int
  --   abst n = Finite (fromIntegral n)
  --   repr (Finite n) = fromInteger n
  
  -- Since Finite is a newtype, the HasRep instance doesn't come into play.
  
  #endif
  
  -- TODO: Generate these dictionaries on the fly during compilation, so we won't
  -- have to list them here.
  
  -- Experimental treatment of Maybe
  instance HasRep (Maybe a) where
    type Rep (Maybe a) = Bool :* a
    repr (Just a) = (True,a)
    repr Nothing  = (False, bottom)
    abst (True,a ) = Just a
    abst (False,_) = Nothing 
    INLINES
  
  -- TODO: LambdaCCC.Prim has an BottomP primitive. If the error ever occurs,
  -- replace with ErrorP (taking a string argument) and tweak the reification.
  
  -- Generalize Maybe to sums:
  
  -- I use this version for circuits. Restore it later, after I'm handing :+ in reify-rules.
  
  -- instance HasRep (a :+ b) where
  --   type Rep (a :+ b) = Bool :* (a :* b)
  --   repr (Left  a) = (False,(a,undefined)) -- error "repr on Maybe: undefined value"
  --   repr (Right b) = (True,(undefined,b))
  --   abst (False,(a,_)) = Left  a
  --   abst (True ,(_,b)) = Right b
  
  -- -- TODO: Redefine `Maybe` representation as sum:
  -- 
  -- type instance Rep (Maybe a) = Unit :+ a
  -- ...
  
  instance HasRep (Complex a) where
    type Rep (Complex a) = a :* a
    repr (a :+ a') = (a,a')
    abst (a,a') = (a :+ a')
    INLINES
  
  -- instance HasRep (G.V1 p) where
  --   type Rep (G.V1 p) = Void
  --   repr = \ case
  --   abst = \ case
  --   INLINES
  
  instance HasRep (G.U1 p) where
    type Rep (G.U1 p) = ()
    repr G.U1 = ()
    abst () = G.U1
    INLINES
  
  instance HasRep (G.Par1 p) where
    type Rep (G.Par1 p) = p
    repr = G.unPar1
    abst = G.Par1
    INLINES
  
  instance HasRep (G.K1 i c p) where
    type Rep (G.K1 i c p) = c
    repr = G.unK1
    abst = G.K1
    INLINES
  
  instance HasRep (G.M1 i c f p) where
    type Rep (G.M1 i c f p) = f p
    repr = G.unM1
    abst = G.M1
    INLINES
  
  instance HasRep ((f G.:+: g) p) where
    type Rep ((f G.:+: g) p) = f p :+ g p
    repr (G.L1  x) = Left  x
    repr (G.R1  x) = Right x
    abst (Left  x) = G.L1  x
    abst (Right x) = G.R1  x
    INLINES
  
  instance HasRep ((f G.:*: g) p) where
    type Rep ((f G.:*: g) p) = f p :* g p
    repr (x G.:*: y) = (x,y)
    abst (x,y) = (x G.:*: y)
    INLINES
  
  instance HasRep ((g G.:.: f) p) where
    type Rep ((g G.:.: f) p) = g (f p)
    repr = G.unComp1
    abst = G.Comp1
    INLINES
  
  -- TODO: Can I *replace* HasRep with Generic?
  
  {--------------------------------------------------------------------
      Utilities
  --------------------------------------------------------------------}
  
  inAbst :: (HasRep p, HasRep q) =>
            (Rep p -> Rep q) -> (p -> q)
  inAbst = abst <~ repr
  {-# INLINE inAbst #-}
  
  inAbst2 :: (HasRep p, HasRep q, HasRep r) =>
             (Rep p -> Rep q -> Rep r) -> (p -> q -> r)
  inAbst2 = inAbst <~ repr
  {-# INLINE inAbst2 #-}
  
  inAbstF1 :: (HasRep p, HasRep q, Functor f) => (f (Rep p) -> Rep q) -> (f p -> q)
  inAbstF1 = abst <~ fmap repr
  {-# INLINE inAbstF1 #-}
  
  inRepr :: (HasRep p, HasRep q) =>
            (p -> q) -> (Rep p -> Rep q)
  inRepr = repr <~ abst
  {-# INLINE inRepr #-}
  
  inRepr2 :: (HasRep p, HasRep q, HasRep r) =>
            (p -> q -> r) -> (Rep p -> Rep q -> Rep r)
  inRepr2 = inRepr <~ abst
  {-# INLINE inRepr2 #-}
  
  {--------------------------------------------------------------------
      Unlifted types
  --------------------------------------------------------------------}
  
  #if 0
  -- Represent unboxed types as boxed counterparts.
  
  instance HasRep Int# where
    type Rep Int# = Int
    abst (I# n) = n
    repr n = I# n
    INLINES
  #elif 0
  -- Represent boxed types as unboxed counterparts.
  
  instance HasRep Int where
    type Rep Int = Int#
    abst n = I# n
    repr (I# n) = n
    INLINES
  
  #endif
  
  
  -- data Int = I# Int# 	-- Defined in ‘GHC.Types’
  
  -- class HasRep (a :: TYPE r) where
  --   type Rep a :: TYPE s
  --   repr :: a -> Rep a
  --   abst :: Rep a -> a
  