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 [Name]
ns = [forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Pred] -> m DerivClause
derivClause forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Quote m => Name -> m Pred
conT [Name]
ns]

unDerivClause :: DerivClause -> [Pred]
unDerivClause :: DerivClause -> [Pred]
unDerivClause (DerivClause Maybe DerivStrategy
_ [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' CxtQ
cxt Name
n [TyVarBndr ()]
bs [ConQ]
cs [Name]
ds = forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [TyVarBndr ()]
-> Maybe Pred
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD CxtQ
cxt Name
n [TyVarBndr ()]
bs forall a. Maybe a
Nothing [ConQ]
cs 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 [Pred]
cxt Name
n [TyVarBndr ()]
bs Maybe Pred
mk [Con]
cs [DerivClause]
ds) = forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr ()]
bs, Maybe Pred
mk, [Con]
cs, [DerivClause]
ds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataD  Dec
_                        = 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' CxtQ
cxt Name
n [TyVarBndr ()]
bs ConQ
c [Name]
ds = forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [TyVarBndr ()]
-> Maybe Pred
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD CxtQ
cxt Name
n [TyVarBndr ()]
bs forall a. Maybe a
Nothing ConQ
c 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 [Pred]
cxt Name
n [TyVarBndr ()]
bs Maybe Pred
mk Con
c [DerivClause]
ds) = forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr ()]
bs, Maybe Pred
mk, Con
c, [DerivClause]
ds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeD  Dec
_                          = 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 -> [TypeQ] -> [ConQ] -> [Name] -> DecQ
dataInstD' CxtQ
cxt Name
n [TypeQ]
as [ConQ]
cs [Name]
ds = forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [m Pred]
-> Maybe Pred
-> [m Con]
-> [m DerivClause]
-> m Dec
dataInstD CxtQ
cxt Name
n [TypeQ]
as forall a. Maybe a
Nothing [ConQ]
cs 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 [Pred]
cxt Maybe [TyVarBndr ()]
b Pred
ty Maybe Pred
mk [Con]
cs [DerivClause]
ds) = forall a. a -> Maybe a
Just ([Pred]
cxt, Maybe [TyVarBndr ()]
b, Pred
ty, Maybe Pred
mk, [Con]
cs, [DerivClause]
ds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataInstD  Dec
_                            = 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 -> [TypeQ] -> ConQ -> [Name] -> DecQ
newtypeInstD' CxtQ
cxt Name
n [TypeQ]
as ConQ
c [Name]
ds = forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [m Pred]
-> Maybe Pred
-> m Con
-> [m DerivClause]
-> m Dec
newtypeInstD CxtQ
cxt Name
n [TypeQ]
as forall a. Maybe a
Nothing ConQ
c 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 [Pred]
cxt Maybe [TyVarBndr ()]
b Pred
ty Maybe Pred
mk Con
c [DerivClause]
ds) = forall a. a -> Maybe a
Just ([Pred]
cxt, Maybe [TyVarBndr ()]
b, Pred
ty, Maybe Pred
mk, Con
c, [DerivClause]
ds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeInstD  Dec
_                              = 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 Maybe Overlap
_ [Pred]
cxt Pred
ty [Dec]
decs) = forall a. a -> Maybe a
Just ([Pred]
cxt, Pred
ty, [Dec]
decs)
unInstanceD  Dec
_                        = forall a. Maybe a
Nothing