module Language.Haskell.TH.Compat.Data.Current (
  dataD', unDataD,
  newtypeD', unNewtypeD,
  dataInstD', unDataInstD,
  newtypeInstD', unNewtypeInstD,
  unInstanceD,
  ) where

import Language.Haskell.TH
  (CxtQ, ConQ, TypeQ, DecQ,
   Cxt, Con, Type, Name, TyVarBndr, Kind,
   Dec (DataD, NewtypeD, DataInstD, NewtypeInstD, InstanceD),
   DerivClauseQ, DerivClause (..), Pred,
   dataD, newtypeD, dataInstD, newtypeInstD, derivClause, conT)


derivesFromNames :: [Name] -> [DerivClauseQ]
derivesFromNames :: [Name] -> [DerivClauseQ]
derivesFromNames ns :: [Name]
ns = [Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing ([PredQ] -> DerivClauseQ) -> [PredQ] -> DerivClauseQ
forall a b. (a -> b) -> a -> b
$ (Name -> PredQ) -> [Name] -> [PredQ]
forall a b. (a -> b) -> [a] -> [b]
map Name -> PredQ
conT [Name]
ns]

unDerivClause :: DerivClause -> [Pred]
unDerivClause :: DerivClause -> [Pred]
unDerivClause (DerivClause _ ps :: [Pred]
ps) = [Pred]
ps

-- | Definition against 'dataD',
--   compatible with before temaplate-haskell-2.11
dataD' :: CxtQ -> Name -> [TyVarBndr] -> [ConQ] -> [Name]
       -> DecQ
dataD' :: CxtQ -> Name -> [TyVarBndr] -> [ConQ] -> [Name] -> DecQ
dataD' cxt :: CxtQ
cxt n :: Name
n bs :: [TyVarBndr]
bs cs :: [ConQ]
cs ds :: [Name]
ds = CxtQ
-> Name
-> [TyVarBndr]
-> Maybe Pred
-> [ConQ]
-> [DerivClauseQ]
-> DecQ
dataD CxtQ
cxt Name
n [TyVarBndr]
bs Maybe Pred
forall a. Maybe a
Nothing [ConQ]
cs ([DerivClauseQ] -> DecQ) -> [DerivClauseQ] -> DecQ
forall a b. (a -> b) -> a -> b
$ [Name] -> [DerivClauseQ]
derivesFromNames [Name]
ds

-- | Compatible interface to destruct 'DataD'
unDataD :: Dec -> Maybe (Cxt, Name, [TyVarBndr], Maybe Kind, [Con], [Type])
unDataD :: Dec -> Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, [Con], [Pred])
unDataD (DataD cxt :: [Pred]
cxt n :: Name
n bs :: [TyVarBndr]
bs mk :: Maybe Pred
mk cs :: [Con]
cs ds :: [DerivClause]
ds) = ([Pred], Name, [TyVarBndr], Maybe Pred, [Con], [Pred])
-> Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, [Con], [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr]
bs, Maybe Pred
mk, [Con]
cs, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataD  _                        = Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, [Con], [Pred])
forall a. Maybe a
Nothing

-- | Definition against 'newtypeD',
--   compatible with before temaplate-haskell-2.11
newtypeD' :: CxtQ -> Name -> [TyVarBndr] -> ConQ -> [Name]
          -> DecQ
newtypeD' :: CxtQ -> Name -> [TyVarBndr] -> ConQ -> [Name] -> DecQ
newtypeD' cxt :: CxtQ
cxt n :: Name
n bs :: [TyVarBndr]
bs c :: ConQ
c ds :: [Name]
ds = CxtQ
-> Name
-> [TyVarBndr]
-> Maybe Pred
-> ConQ
-> [DerivClauseQ]
-> DecQ
newtypeD CxtQ
cxt Name
n [TyVarBndr]
bs Maybe Pred
forall a. Maybe a
Nothing ConQ
c ([DerivClauseQ] -> DecQ) -> [DerivClauseQ] -> DecQ
forall a b. (a -> b) -> a -> b
$ [Name] -> [DerivClauseQ]
derivesFromNames [Name]
ds

-- | Compatible interface to destruct 'NewtypeD'
unNewtypeD :: Dec -> Maybe (Cxt, Name, [TyVarBndr], Maybe Kind, Con, [Type])
unNewtypeD :: Dec -> Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, Con, [Pred])
unNewtypeD (NewtypeD cxt :: [Pred]
cxt n :: Name
n bs :: [TyVarBndr]
bs mk :: Maybe Pred
mk c :: Con
c ds :: [DerivClause]
ds) = ([Pred], Name, [TyVarBndr], Maybe Pred, Con, [Pred])
-> Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, Con, [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr]
bs, Maybe Pred
mk, Con
c, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeD  _                          = Maybe ([Pred], Name, [TyVarBndr], Maybe Pred, Con, [Pred])
forall a. Maybe a
Nothing

-- | Definition against 'dataInstD',
--   compatible with before temaplate-haskell-2.11
dataInstD' :: CxtQ -> Name -> [TypeQ] -> [ConQ] -> [Name]
           -> DecQ
dataInstD' :: CxtQ -> Name -> [PredQ] -> [ConQ] -> [Name] -> DecQ
dataInstD' cxt :: CxtQ
cxt n :: Name
n as :: [PredQ]
as cs :: [ConQ]
cs ds :: [Name]
ds = CxtQ
-> Name
-> [PredQ]
-> Maybe Pred
-> [ConQ]
-> [DerivClauseQ]
-> DecQ
dataInstD CxtQ
cxt Name
n [PredQ]
as Maybe Pred
forall a. Maybe a
Nothing [ConQ]
cs ([DerivClauseQ] -> DecQ) -> [DerivClauseQ] -> DecQ
forall a b. (a -> b) -> a -> b
$ [Name] -> [DerivClauseQ]
derivesFromNames [Name]
ds

-- | Compatible interface to destruct 'DataInstD'
unDataInstD :: Dec -> Maybe (Cxt, Maybe [TyVarBndr], Type, Maybe Kind, [Con], [Type])
unDataInstD :: Dec
-> Maybe
     ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, [Con], [Pred])
unDataInstD (DataInstD cxt :: [Pred]
cxt b :: Maybe [TyVarBndr]
b ty :: Pred
ty mk :: Maybe Pred
mk cs :: [Con]
cs ds :: [DerivClause]
ds) = ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, [Con], [Pred])
-> Maybe
     ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, [Con], [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Maybe [TyVarBndr]
b, Pred
ty, Maybe Pred
mk, [Con]
cs, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataInstD  _                            = Maybe ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, [Con], [Pred])
forall a. Maybe a
Nothing

-- | Definition against 'newtypeInstD',
--   compatible with before temaplate-haskell-2.11
newtypeInstD' :: CxtQ -> Name -> [TypeQ] -> ConQ -> [Name]
              -> DecQ
newtypeInstD' :: CxtQ -> Name -> [PredQ] -> ConQ -> [Name] -> DecQ
newtypeInstD' cxt :: CxtQ
cxt n :: Name
n as :: [PredQ]
as c :: ConQ
c ds :: [Name]
ds = CxtQ
-> Name -> [PredQ] -> Maybe Pred -> ConQ -> [DerivClauseQ] -> DecQ
newtypeInstD CxtQ
cxt Name
n [PredQ]
as Maybe Pred
forall a. Maybe a
Nothing ConQ
c ([DerivClauseQ] -> DecQ) -> [DerivClauseQ] -> DecQ
forall a b. (a -> b) -> a -> b
$ [Name] -> [DerivClauseQ]
derivesFromNames [Name]
ds

-- | Compatible interface to destruct 'NewtypeInstD'
unNewtypeInstD :: Dec -> Maybe (Cxt, Maybe [TyVarBndr], Type, Maybe Kind, Con, [Type])
unNewtypeInstD :: Dec
-> Maybe ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, Con, [Pred])
unNewtypeInstD (NewtypeInstD cxt :: [Pred]
cxt b :: Maybe [TyVarBndr]
b ty :: Pred
ty mk :: Maybe Pred
mk c :: Con
c ds :: [DerivClause]
ds) = ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, Con, [Pred])
-> Maybe ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, Con, [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Maybe [TyVarBndr]
b, Pred
ty, Maybe Pred
mk, Con
c, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeInstD  _                              = Maybe ([Pred], Maybe [TyVarBndr], Pred, Maybe Pred, Con, [Pred])
forall a. Maybe a
Nothing

-- | Compatible interface to destruct 'InstanceD'
--   No Overlap type is defined before template-haskell-2.11.
unInstanceD :: Dec -> Maybe (Cxt, Type, [Dec])
unInstanceD :: Dec -> Maybe ([Pred], Pred, [Dec])
unInstanceD (InstanceD _ cxt :: [Pred]
cxt ty :: Pred
ty decs :: [Dec]
decs) = ([Pred], Pred, [Dec]) -> Maybe ([Pred], Pred, [Dec])
forall a. a -> Maybe a
Just ([Pred]
cxt, Pred
ty, [Dec]
decs)
unInstanceD  _                        = Maybe ([Pred], Pred, [Dec])
forall a. Maybe a
Nothing