{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module Language.C99.Util.Wrap
  ( Wrap
  , wrap
  ) where

import Language.C99.AST


{- Wraps only a single layer -}
class WrapStep a b | a -> b  where
  wrapstep :: a -> b

instance WrapStep Expr PrimExpr where
  wrapstep :: Expr -> PrimExpr
wrapstep = Expr -> PrimExpr
PrimExpr (Expr -> PrimExpr) -> (Expr -> Expr) -> Expr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep PrimExpr PostfixExpr where
  wrapstep :: PrimExpr -> PostfixExpr
wrapstep = PrimExpr -> PostfixExpr
PostfixPrim (PrimExpr -> PostfixExpr)
-> (PrimExpr -> PrimExpr) -> PrimExpr -> PostfixExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> PrimExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep PostfixExpr UnaryExpr where
  wrapstep :: PostfixExpr -> UnaryExpr
wrapstep = PostfixExpr -> UnaryExpr
UnaryPostfix (PostfixExpr -> UnaryExpr)
-> (PostfixExpr -> PostfixExpr) -> PostfixExpr -> UnaryExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PostfixExpr -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep UnaryExpr CastExpr where
  wrapstep :: UnaryExpr -> CastExpr
wrapstep = UnaryExpr -> CastExpr
CastUnary (UnaryExpr -> CastExpr)
-> (UnaryExpr -> UnaryExpr) -> UnaryExpr -> CastExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryExpr -> UnaryExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep CastExpr MultExpr where
  wrapstep :: CastExpr -> MultExpr
wrapstep = CastExpr -> MultExpr
MultCast (CastExpr -> MultExpr)
-> (CastExpr -> CastExpr) -> CastExpr -> MultExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastExpr -> CastExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep MultExpr AddExpr where
  wrapstep :: MultExpr -> AddExpr
wrapstep = MultExpr -> AddExpr
AddMult (MultExpr -> AddExpr)
-> (MultExpr -> MultExpr) -> MultExpr -> AddExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultExpr -> MultExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep AddExpr ShiftExpr where
  wrapstep :: AddExpr -> ShiftExpr
wrapstep = AddExpr -> ShiftExpr
ShiftAdd (AddExpr -> ShiftExpr)
-> (AddExpr -> AddExpr) -> AddExpr -> ShiftExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddExpr -> AddExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep ShiftExpr RelExpr where
  wrapstep :: ShiftExpr -> RelExpr
wrapstep = ShiftExpr -> RelExpr
RelShift (ShiftExpr -> RelExpr)
-> (ShiftExpr -> ShiftExpr) -> ShiftExpr -> RelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShiftExpr -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep RelExpr EqExpr where
  wrapstep :: RelExpr -> EqExpr
wrapstep = RelExpr -> EqExpr
EqRel (RelExpr -> EqExpr) -> (RelExpr -> RelExpr) -> RelExpr -> EqExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelExpr -> RelExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep EqExpr AndExpr where
  wrapstep :: EqExpr -> AndExpr
wrapstep = EqExpr -> AndExpr
AndEq (EqExpr -> AndExpr) -> (EqExpr -> EqExpr) -> EqExpr -> AndExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqExpr -> EqExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep AndExpr XOrExpr where
  wrapstep :: AndExpr -> XOrExpr
wrapstep = AndExpr -> XOrExpr
XOrAnd (AndExpr -> XOrExpr) -> (AndExpr -> AndExpr) -> AndExpr -> XOrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AndExpr -> AndExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep XOrExpr OrExpr where
  wrapstep :: XOrExpr -> OrExpr
wrapstep = XOrExpr -> OrExpr
OrXOr (XOrExpr -> OrExpr) -> (XOrExpr -> XOrExpr) -> XOrExpr -> OrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOrExpr -> XOrExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep OrExpr LAndExpr where
  wrapstep :: OrExpr -> LAndExpr
wrapstep = OrExpr -> LAndExpr
LAndOr (OrExpr -> LAndExpr) -> (OrExpr -> OrExpr) -> OrExpr -> LAndExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrExpr -> OrExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep LAndExpr LOrExpr where
  wrapstep :: LAndExpr -> LOrExpr
wrapstep = LAndExpr -> LOrExpr
LOrAnd (LAndExpr -> LOrExpr)
-> (LAndExpr -> LAndExpr) -> LAndExpr -> LOrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LAndExpr -> LAndExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep LOrExpr CondExpr where
  wrapstep :: LOrExpr -> CondExpr
wrapstep = LOrExpr -> CondExpr
CondLOr (LOrExpr -> CondExpr)
-> (LOrExpr -> LOrExpr) -> LOrExpr -> CondExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LOrExpr -> LOrExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep CondExpr AssignExpr where
  wrapstep :: CondExpr -> AssignExpr
wrapstep = CondExpr -> AssignExpr
AssignCond (CondExpr -> AssignExpr)
-> (CondExpr -> CondExpr) -> CondExpr -> AssignExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondExpr -> CondExpr
forall a b. Wrap a b => a -> b
wrap

instance WrapStep AssignExpr Expr where
  wrapstep :: AssignExpr -> Expr
wrapstep = AssignExpr -> Expr
ExprAssign (AssignExpr -> Expr)
-> (AssignExpr -> AssignExpr) -> AssignExpr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssignExpr -> AssignExpr
forall a b. Wrap a b => a -> b
wrap


{- Wraps multiple layers -}
{- We write specific instances to help Haskell's type system. Using variables
   allows us to wrap _anything_, which will lead to inifite loops if no
   suitable instance is found.
-}
class Wrap a b where
  wrap    :: a -> b

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b PrimExpr)
  => Wrap a PrimExpr where
    wrap :: a -> PrimExpr
wrap = b -> PrimExpr
forall a b. Wrap a b => a -> b
wrap (b -> PrimExpr) -> (a -> b) -> a -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b PostfixExpr)
  => Wrap a PostfixExpr where
    wrap :: a -> PostfixExpr
wrap = b -> PostfixExpr
forall a b. Wrap a b => a -> b
wrap (b -> PostfixExpr) -> (a -> b) -> a -> PostfixExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b UnaryExpr)
  => Wrap a UnaryExpr where
    wrap :: a -> UnaryExpr
wrap = b -> UnaryExpr
forall a b. Wrap a b => a -> b
wrap (b -> UnaryExpr) -> (a -> b) -> a -> UnaryExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b CastExpr)
  => Wrap a CastExpr where
    wrap :: a -> CastExpr
wrap = b -> CastExpr
forall a b. Wrap a b => a -> b
wrap (b -> CastExpr) -> (a -> b) -> a -> CastExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b MultExpr)
  => Wrap a MultExpr where
    wrap :: a -> MultExpr
wrap = b -> MultExpr
forall a b. Wrap a b => a -> b
wrap (b -> MultExpr) -> (a -> b) -> a -> MultExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b AddExpr)
  => Wrap a AddExpr where
    wrap :: a -> AddExpr
wrap = b -> AddExpr
forall a b. Wrap a b => a -> b
wrap (b -> AddExpr) -> (a -> b) -> a -> AddExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b ShiftExpr)
  => Wrap a ShiftExpr where
    wrap :: a -> ShiftExpr
wrap = b -> ShiftExpr
forall a b. Wrap a b => a -> b
wrap (b -> ShiftExpr) -> (a -> b) -> a -> ShiftExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b RelExpr)
  => Wrap a RelExpr where
    wrap :: a -> RelExpr
wrap = b -> RelExpr
forall a b. Wrap a b => a -> b
wrap (b -> RelExpr) -> (a -> b) -> a -> RelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b EqExpr)
  => Wrap a EqExpr where
    wrap :: a -> EqExpr
wrap = b -> EqExpr
forall a b. Wrap a b => a -> b
wrap (b -> EqExpr) -> (a -> b) -> a -> EqExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b AndExpr)
  => Wrap a AndExpr where
    wrap :: a -> AndExpr
wrap = b -> AndExpr
forall a b. Wrap a b => a -> b
wrap (b -> AndExpr) -> (a -> b) -> a -> AndExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b OrExpr)
  => Wrap a OrExpr where
    wrap :: a -> OrExpr
wrap = b -> OrExpr
forall a b. Wrap a b => a -> b
wrap (b -> OrExpr) -> (a -> b) -> a -> OrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b XOrExpr)
  => Wrap a XOrExpr where
    wrap :: a -> XOrExpr
wrap = b -> XOrExpr
forall a b. Wrap a b => a -> b
wrap (b -> XOrExpr) -> (a -> b) -> a -> XOrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b LAndExpr)
  => Wrap a LAndExpr where
    wrap :: a -> LAndExpr
wrap = b -> LAndExpr
forall a b. Wrap a b => a -> b
wrap (b -> LAndExpr) -> (a -> b) -> a -> LAndExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b LOrExpr)
  => Wrap a LOrExpr where
    wrap :: a -> LOrExpr
wrap = b -> LOrExpr
forall a b. Wrap a b => a -> b
wrap (b -> LOrExpr) -> (a -> b) -> a -> LOrExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b CondExpr)
  => Wrap a CondExpr where
    wrap :: a -> CondExpr
wrap = b -> CondExpr
forall a b. Wrap a b => a -> b
wrap (b -> CondExpr) -> (a -> b) -> a -> CondExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b AssignExpr)
  => Wrap a AssignExpr where
    wrap :: a -> AssignExpr
wrap = b -> AssignExpr
forall a b. Wrap a b => a -> b
wrap (b -> AssignExpr) -> (a -> b) -> a -> AssignExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep

instance {-# OVERLAPPABLE #-} (WrapStep a b, Wrap b Expr)
  => Wrap a Expr where
    wrap :: a -> Expr
wrap = b -> Expr
forall a b. Wrap a b => a -> b
wrap (b -> Expr) -> (a -> b) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. WrapStep a b => a -> b
wrapstep


{- We provide specific identity instances as well, to eliminate unsolvable
   overlapping instances.
-}
instance {-# OVERLAPPABLE #-} Wrap PrimExpr PrimExpr where
  wrap :: PrimExpr -> PrimExpr
wrap = PrimExpr -> PrimExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap PostfixExpr PostfixExpr where
  wrap :: PostfixExpr -> PostfixExpr
wrap = PostfixExpr -> PostfixExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap UnaryExpr UnaryExpr where
  wrap :: UnaryExpr -> UnaryExpr
wrap = UnaryExpr -> UnaryExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap CastExpr CastExpr where
  wrap :: CastExpr -> CastExpr
wrap = CastExpr -> CastExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap MultExpr MultExpr where
  wrap :: MultExpr -> MultExpr
wrap = MultExpr -> MultExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap AddExpr AddExpr where
  wrap :: AddExpr -> AddExpr
wrap = AddExpr -> AddExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap ShiftExpr ShiftExpr where
  wrap :: ShiftExpr -> ShiftExpr
wrap = ShiftExpr -> ShiftExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap RelExpr RelExpr where
  wrap :: RelExpr -> RelExpr
wrap = RelExpr -> RelExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap EqExpr EqExpr where
  wrap :: EqExpr -> EqExpr
wrap = EqExpr -> EqExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap AndExpr AndExpr where
  wrap :: AndExpr -> AndExpr
wrap = AndExpr -> AndExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap OrExpr OrExpr where
  wrap :: OrExpr -> OrExpr
wrap = OrExpr -> OrExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap XOrExpr XOrExpr where
  wrap :: XOrExpr -> XOrExpr
wrap = XOrExpr -> XOrExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap LAndExpr LAndExpr where
  wrap :: LAndExpr -> LAndExpr
wrap = LAndExpr -> LAndExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap LOrExpr LOrExpr where
  wrap :: LOrExpr -> LOrExpr
wrap = LOrExpr -> LOrExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap CondExpr CondExpr where
  wrap :: CondExpr -> CondExpr
wrap = CondExpr -> CondExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap AssignExpr AssignExpr where
  wrap :: AssignExpr -> AssignExpr
wrap = AssignExpr -> AssignExpr
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} Wrap Expr Expr where
  wrap :: Expr -> Expr
wrap = Expr -> Expr
forall a. a -> a
id