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, BndrVis, 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 = [Maybe DerivStrategy -> [Q Pred] -> DerivClauseQ
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Pred] -> m DerivClause
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing ([Q Pred] -> DerivClauseQ) -> [Q Pred] -> DerivClauseQ
forall a b. (a -> b) -> a -> b
$ (Name -> Q Pred) -> [Name] -> [Q Pred]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Q Pred
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 BndrVis] -> [ConQ] -> [Name]
       -> DecQ
dataD' :: CxtQ -> Name -> [TyVarBndr BndrVis] -> [ConQ] -> [Name] -> DecQ
dataD' CxtQ
cxt Name
n [TyVarBndr BndrVis]
bs [ConQ]
cs [Name]
ds = CxtQ
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Pred
-> [ConQ]
-> [DerivClauseQ]
-> DecQ
forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Pred
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD CxtQ
cxt Name
n [TyVarBndr BndrVis]
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 BndrVis], Maybe Kind, [Con], [Type])
unDataD :: Dec
-> Maybe
     ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, [Con], [Pred])
unDataD (DataD [Pred]
cxt Name
n [TyVarBndr BndrVis]
bs Maybe Pred
mk [Con]
cs [DerivClause]
ds) = ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, [Con], [Pred])
-> Maybe
     ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, [Con], [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr BndrVis]
bs, Maybe Pred
mk, [Con]
cs, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataD  Dec
_                        = Maybe
  ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, [Con], [Pred])
forall a. Maybe a
Nothing

-- | Definition against 'newtypeD',
--   compatible with before temaplate-haskell-2.11
newtypeD' :: CxtQ -> Name -> [TyVarBndr BndrVis] -> ConQ -> [Name]
          -> DecQ
newtypeD' :: CxtQ -> Name -> [TyVarBndr BndrVis] -> ConQ -> [Name] -> DecQ
newtypeD' CxtQ
cxt Name
n [TyVarBndr BndrVis]
bs ConQ
c [Name]
ds = CxtQ
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Pred
-> ConQ
-> [DerivClauseQ]
-> DecQ
forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Pred
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD CxtQ
cxt Name
n [TyVarBndr BndrVis]
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 BndrVis], Maybe Kind, Con, [Type])
unNewtypeD :: Dec
-> Maybe
     ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, Con, [Pred])
unNewtypeD (NewtypeD [Pred]
cxt Name
n [TyVarBndr BndrVis]
bs Maybe Pred
mk Con
c [DerivClause]
ds) = ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, Con, [Pred])
-> Maybe
     ([Pred], Name, [TyVarBndr BndrVis], Maybe Pred, Con, [Pred])
forall a. a -> Maybe a
Just ([Pred]
cxt, Name
n, [TyVarBndr BndrVis]
bs, Maybe Pred
mk, Con
c, [DerivClause]
ds [DerivClause] -> (DerivClause -> [Pred]) -> [Pred]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeD  Dec
_                          = Maybe ([Pred], Name, [TyVarBndr BndrVis], 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 -> [Q Pred] -> [ConQ] -> [Name] -> DecQ
dataInstD' CxtQ
cxt Name
n [Q Pred]
as [ConQ]
cs [Name]
ds = CxtQ
-> Name
-> [Q Pred]
-> Maybe Pred
-> [ConQ]
-> [DerivClauseQ]
-> DecQ
forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [m Pred]
-> Maybe Pred
-> [m Con]
-> [m DerivClause]
-> m Dec
dataInstD CxtQ
cxt Name
n [Q Pred]
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 [Pred]
cxt Maybe [TyVarBndr ()]
b Pred
ty Maybe Pred
mk [Con]
cs [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 a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unDataInstD  Dec
_                            = 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 -> [Q Pred] -> ConQ -> [Name] -> DecQ
newtypeInstD' CxtQ
cxt Name
n [Q Pred]
as ConQ
c [Name]
ds = CxtQ
-> Name -> [Q Pred] -> Maybe Pred -> ConQ -> [DerivClauseQ] -> DecQ
forall (m :: * -> *).
Quote m =>
m [Pred]
-> Name
-> [m Pred]
-> Maybe Pred
-> m Con
-> [m DerivClause]
-> m Dec
newtypeInstD CxtQ
cxt Name
n [Q Pred]
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 [Pred]
cxt Maybe [TyVarBndr ()]
b Pred
ty Maybe Pred
mk Con
c [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 a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DerivClause -> [Pred]
unDerivClause)
unNewtypeInstD  Dec
_                              = 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 Maybe Overlap
_ [Pred]
cxt Pred
ty [Dec]
decs) = ([Pred], Pred, [Dec]) -> Maybe ([Pred], Pred, [Dec])
forall a. a -> Maybe a
Just ([Pred]
cxt, Pred
ty, [Dec]
decs)
unInstanceD  Dec
_                        = Maybe ([Pred], Pred, [Dec])
forall a. Maybe a
Nothing