{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Comp.Derive.Utils
-- Copyright   :  (c) 2010-2011 Patrick Bahr
-- License     :  BSD3
-- Maintainer  :  Patrick Bahr <paba@diku.dk>
-- Stability   :  experimental
-- Portability :  non-portable (GHC Extensions)
--
-- This module defines some utility functions for deriving instances
-- for functor based type classes.
--
--------------------------------------------------------------------------------
module Data.Comp.Derive.Utils where


import Control.Monad
import Data.Proxy
import Language.Haskell.TH
import Language.Haskell.TH.ExpandSyns
import Language.Haskell.TH.Syntax

data DataInfo = DataInfo Cxt Name [TyVarBndr BndrVis] [Con] [DerivClause]

{-|
  This is the @Q@-lifted version of 'abstractNewtype.
-}
abstractNewtypeQ :: Q Info -> Q (Maybe DataInfo)
abstractNewtypeQ :: Q Info -> Q (Maybe DataInfo)
abstractNewtypeQ = (Info -> Maybe DataInfo) -> Q Info -> Q (Maybe DataInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Info -> Maybe DataInfo
abstractNewtype

{-|
  This function abstracts away @newtype@ declaration, it turns them into
  @data@ declarations.
-}
abstractNewtype :: Info -> Maybe DataInfo
abstractNewtype :: Info -> Maybe DataInfo
abstractNewtype (TyConI (NewtypeD Cxt
cxt Name
name [TyVarBndr BndrVis]
args Maybe Type
_ Con
constr [DerivClause]
derive))
    = DataInfo -> Maybe DataInfo
forall a. a -> Maybe a
Just (Cxt
-> Name
-> [TyVarBndr BndrVis]
-> [Con]
-> [DerivClause]
-> DataInfo
DataInfo Cxt
cxt Name
name [TyVarBndr BndrVis]
args [Con
constr] [DerivClause]
derive)
abstractNewtype (TyConI (DataD Cxt
cxt Name
name [TyVarBndr BndrVis]
args Maybe Type
_ [Con]
constrs [DerivClause]
derive))
    = DataInfo -> Maybe DataInfo
forall a. a -> Maybe a
Just (Cxt
-> Name
-> [TyVarBndr BndrVis]
-> [Con]
-> [DerivClause]
-> DataInfo
DataInfo Cxt
cxt Name
name [TyVarBndr BndrVis]
args [Con]
constrs [DerivClause]
derive)
abstractNewtype Info
_ = Maybe DataInfo
forall a. Maybe a
Nothing

{-| This function provides the name and the arity of the given data
constructor, and if it is a GADT also its type.
-}
normalCon :: Con -> (Name,[StrictType], Maybe Type)
normalCon :: Con -> (Name, [StrictType], Maybe Type)
normalCon (NormalC Name
constr [StrictType]
args) = (Name
constr, [StrictType]
args, Maybe Type
forall a. Maybe a
Nothing)
normalCon (RecC Name
constr [VarBangType]
args) = (Name
constr, (VarBangType -> StrictType) -> [VarBangType] -> [StrictType]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
_,Bang
s,Type
t) -> (Bang
s,Type
t)) [VarBangType]
args, Maybe Type
forall a. Maybe a
Nothing)
normalCon (InfixC StrictType
a Name
constr StrictType
b) = (Name
constr, [StrictType
a,StrictType
b], Maybe Type
forall a. Maybe a
Nothing)
normalCon (ForallC [TyVarBndr Specificity]
_ Cxt
_ Con
constr) = Con -> (Name, [StrictType], Maybe Type)
normalCon Con
constr
normalCon (GadtC (Name
constr:[Name]
_constrs) [StrictType]
args Type
typ) = (Name
constr,[StrictType]
args,Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typ)

normalCon' :: Con -> (Name,[Type], Maybe Type)
normalCon' :: Con -> (Name, Cxt, Maybe Type)
normalCon' Con
con = (Name
n, (StrictType -> Type) -> [StrictType] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map StrictType -> Type
forall a b. (a, b) -> b
snd [StrictType]
ts, Maybe Type
t)
  where (Name
n, [StrictType]
ts, Maybe Type
t) = Con -> (Name, [StrictType], Maybe Type)
normalCon Con
con
      

-- -- | Same as normalCon' but expands type synonyms.
-- normalConExp :: Con -> Q (Name,[Type])
-- normalConExp c = do
--   let (n,ts,t) = normalCon' c
--   ts' <- mapM expandSyns ts
--   return (n, ts')

-- | Same as normalCon' but expands type synonyms.
normalConExp :: Con -> Q (Name,[Type], Maybe Type)
normalConExp :: Con -> Q (Name, Cxt, Maybe Type)
normalConExp Con
c = do
  let (Name
n,Cxt
ts,Maybe Type
t) = Con -> (Name, Cxt, Maybe Type)
normalCon' Con
c
  Cxt
ts' <- (Type -> Q Type) -> Cxt -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> Q Type
expandSyns Cxt
ts
  (Name, Cxt, Maybe Type) -> Q (Name, Cxt, Maybe Type)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Cxt
ts',Maybe Type
t)


-- | Same as normalConExp' but retains strictness annotations.
normalConStrExp :: Con -> Q (Name,[StrictType], Maybe Type)
normalConStrExp :: Con -> Q (Name, [StrictType], Maybe Type)
normalConStrExp Con
c = do
  let (Name
n,[StrictType]
ts,Maybe Type
t) = Con -> (Name, [StrictType], Maybe Type)
normalCon Con
c
  [StrictType]
ts' <- (StrictType -> Q StrictType) -> [StrictType] -> Q [StrictType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ (Bang
st,Type
ty) -> do Type
ty' <- Type -> Q Type
expandSyns Type
ty; StrictType -> Q StrictType
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bang
st,Type
ty')) [StrictType]
ts
  (Name, [StrictType], Maybe Type)
-> Q (Name, [StrictType], Maybe Type)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, [StrictType]
ts',Maybe Type
t)

-- | Auxiliary function to extract the first argument of a binary type
-- application (the second argument of this function). If the second
-- argument is @Nothing@ or not of the right shape, the first argument
-- is returned as a default.

getBinaryFArg :: Type -> Maybe Type -> Type
getBinaryFArg :: Type -> Maybe Type -> Type
getBinaryFArg Type
_ (Just (AppT (AppT Type
_ Type
t)  Type
_)) = Type
t
getBinaryFArg Type
def Maybe Type
_ = Type
def

-- | Auxiliary function to extract the first argument of a type
-- application (the second argument of this function). If the second
-- argument is @Nothing@ or not of the right shape, the first argument
-- is returned as a default.
getUnaryFArg :: Type -> Maybe Type -> Type
getUnaryFArg :: Type -> Maybe Type -> Type
getUnaryFArg Type
_ (Just (AppT Type
_ Type
t)) = Type
t
getUnaryFArg Type
def Maybe Type
_ = Type
def



{-|
  This function provides the name and the arity of the given data constructor.
-}
abstractConType :: Con -> (Name,Int)
abstractConType :: Con -> (Name, Int)
abstractConType (NormalC Name
constr [StrictType]
args) = (Name
constr, [StrictType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StrictType]
args)
abstractConType (RecC Name
constr [VarBangType]
args) = (Name
constr, [VarBangType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VarBangType]
args)
abstractConType (InfixC StrictType
_ Name
constr StrictType
_) = (Name
constr, Int
2)
abstractConType (ForallC [TyVarBndr Specificity]
_ Cxt
_ Con
constr) = Con -> (Name, Int)
abstractConType Con
constr
abstractConType (GadtC (Name
constr:[Name]
_) [StrictType]
args Type
_typ) = (Name
constr,[StrictType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StrictType]
args) -- Only first Name

{-|
  This function returns the name of a bound type variable
-}
tyVarBndrName :: TyVarBndr BndrVis -> Name
tyVarBndrName :: TyVarBndr BndrVis -> Name
tyVarBndrName (PlainTV Name
n BndrVis
_) = Name
n
tyVarBndrName (KindedTV Name
n BndrVis
_ Type
_) = Name
n

containsType :: Type -> Type -> Bool
containsType :: Type -> Type -> Bool
containsType Type
s Type
t
             | Type
s Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t = Bool
True
             | Bool
otherwise = case Type
s of
                             ForallT [TyVarBndr Specificity]
_ Cxt
_ Type
s' -> Type -> Type -> Bool
containsType Type
s' Type
t
                             AppT Type
s1 Type
s2 -> Type -> Type -> Bool
containsType Type
s1 Type
t Bool -> Bool -> Bool
|| Type -> Type -> Bool
containsType Type
s2 Type
t
                             SigT Type
s' Type
_ -> Type -> Type -> Bool
containsType Type
s' Type
t
                             Type
_ -> Bool
False

containsType' :: Type -> Type -> [Int]
containsType' :: Type -> Type -> [Int]
containsType' = Int -> Type -> Type -> [Int]
forall {t}. Num t => t -> Type -> Type -> [t]
run Int
0
    where run :: t -> Type -> Type -> [t]
run t
n Type
s Type
t
             | Type
s Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t = [t
n]
             | Bool
otherwise = case Type
s of
                             ForallT [TyVarBndr Specificity]
_ Cxt
_ Type
s' -> t -> Type -> Type -> [t]
run t
n Type
s' Type
t
                             -- only going through the right-hand side counts!
                             AppT Type
s1 Type
s2 -> t -> Type -> Type -> [t]
run t
n Type
s1 Type
t [t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ t -> Type -> Type -> [t]
run (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) Type
s2 Type
t
                             SigT Type
s' Type
_ -> t -> Type -> Type -> [t]
run t
n Type
s' Type
t
                             Type
_ -> []


{-|
  This function provides a list (of the given length) of new names based
  on the given string.
-}
newNames :: Int -> String -> Q [Name]
newNames :: Int -> String -> Q [Name]
newNames Int
n String
name = Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
name)

tupleTypes :: Int -> Int -> [Name]
tupleTypes Int
n Int
m = (Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Name
tupleTypeName [Int
n..Int
m]

{-| Helper function for generating a list of instances for a list of named
 signatures. For example, in order to derive instances 'Functor' and
 'ShowF' for a signature @Exp@, use derive as follows (requires Template
 Haskell):

 > $(derive [makeFunctor, makeShowF] [''Exp])
 -}
derive :: [Name -> Q [Dec]] -> [Name] -> Q [Dec]
derive :: [Name -> Q [Dec]] -> [Name] -> Q [Dec]
derive [Name -> Q [Dec]]
ders [Name]
names = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Q [Dec]] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Name -> Q [Dec]
der Name
name | Name -> Q [Dec]
der <- [Name -> Q [Dec]]
ders, Name
name <- [Name]
names]

{-| Apply a class name to type arguments to construct a type class
    constraint.
-}

mkClassP :: Name -> [Type] -> Type
mkClassP :: Name -> Cxt -> Type
mkClassP Name
name = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
name)

{-| This function checks whether the given type constraint is an
equality constraint. If so, the types of the equality constraint are
returned. -}

isEqualP :: Type -> Maybe (Type, Type)
isEqualP :: Type -> Maybe (Type, Type)
isEqualP (AppT (AppT Type
EqualityT Type
x) Type
y) = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y)
isEqualP (AppT (AppT (ConT Name
eqOp) Type
x) Type
y)
  |  Name
eqOp Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''(~)                   = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
x, Type
y)
isEqualP Type
_ = Maybe (Type, Type)
forall a. Maybe a
Nothing

mkInstanceD :: Cxt -> Type -> [Dec] -> Dec
mkInstanceD :: Cxt -> Type -> [Dec] -> Dec
mkInstanceD Cxt
cxt Type
ty [Dec]
decs = Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing Cxt
cxt Type
ty [Dec]
decs


-- | This function lifts type class instances over sums
-- of signatures. To this end it assumes that it contains only methods
-- with types of the form @f t1 .. tn -> t@ where @f@ is the signature
-- that is used to construct sums. It also assumes that the sum of signatures
-- occur in the last position in class head. Eg: HasVars v f
-- Since this function is generic it
-- assumes as its first argument the name of the function that is
-- used to lift methods over sums i.e. a function of type
--
-- @
-- (forall f. f t1 .. tn -> t) -> (Sum fs t1 .. tn -> t)
-- @
--
-- where @Sum@ is the sum type constructor. The second argument to
-- this function is expected to be the name of that constructor. The
-- last argument is the name of the class whose instances should be
-- lifted over sums. The class should be such that the last parameter
-- is that of the signature.

liftSumGen :: Name -> Name -> Name -> Name -> Q [Dec]
liftSumGen :: Name -> Name -> Name -> Name -> Q [Dec]
liftSumGen Name
caseName Name
sumName Name
allName Name
fname = do
  ClassI (ClassD Cxt
_ Name
name [TyVarBndr BndrVis]
targs_ [FunDep]
_ [Dec]
decs) [Dec]
_ <- Name -> Q Info
reify Name
fname
  let targs :: [Name]
targs = (TyVarBndr BndrVis -> Name) -> [TyVarBndr BndrVis] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr BndrVis -> Name
tyVarBndrName [TyVarBndr BndrVis]
targs_
      ts :: Cxt
ts = (Name -> Type) -> [Name] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT ([Name] -> [Name]
forall a. HasCallStack => [a] -> [a]
init [Name]
targs)
  Name
fs <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"fs"
  case [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
targs of
    Bool
True -> do
      String -> Q ()
reportError (String -> Q ()) -> String -> Q ()
forall a b. (a -> b) -> a -> b
$ String
"Class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be lifted to sums!"
      [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Bool
False -> do
      Type
allCxt <- Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
allName Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Q Type
clsTypeM Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
fs
      let cxt :: Cxt
cxt = [ Type
allCxt ]
      let tp :: Type
tp = Name -> Type
ConT Name
sumName Type -> Type -> Type
`AppT` Name -> Type
VarT Name
fs
      let complType :: Type
complType = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
name) Cxt
ts Type -> Type -> Type
`AppT` Type
tp
      [Dec]
decs' <- [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> Q [Dec]) -> [Q Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ (Dec -> [Q Dec]) -> [Dec] -> [Q Dec]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Dec -> [Q Dec]
decl [Dec]
decs
      [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Cxt -> Type -> [Dec] -> Dec
mkInstanceD Cxt
cxt Type
complType [Dec]
decs']
        where decl :: Dec -> [DecQ]
              decl :: Dec -> [Q Dec]
decl (SigD Name
f Type
_) = [Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
f [Name -> Q Clause
clause Name
f]]
              decl Dec
_ = []
              clause :: Name -> ClauseQ
              clause :: Name -> Q Clause
clause Name
f = do Name
x <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
                            Type
clsType <- Q Type
clsTypeM
                            let b :: Body
b = Exp -> Body
NormalB (Name -> Exp
VarE Name
caseName Exp -> Type -> Exp
`AppTypeE` Type
clsType Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
f Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
x)
                            Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x] Body
b []
              clsTypeM :: Q Type
clsTypeM = (Q Type -> Type -> Q Type) -> Q Type -> Cxt -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Q Type
acc Type
a -> Q Type
acc Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
a) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
name) Cxt
ts


findSig :: [Name] -> [Dec] -> Q (Maybe ([Name],[Name]))
findSig :: [Name] -> [Dec] -> Q (Maybe ([Name], [Name]))
findSig [Name]
targs [Dec]
decs = case (Dec -> Q (Maybe Name)) -> [Dec] -> [Q (Maybe Name)]
forall a b. (a -> b) -> [a] -> [b]
map Dec -> Q (Maybe Name)
run [Dec]
decs of
                       []  -> Maybe ([Name], [Name]) -> Q (Maybe ([Name], [Name]))
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Name], [Name])
forall a. Maybe a
Nothing
                       Q (Maybe Name)
mx:[Q (Maybe Name)]
_ -> do Maybe Name
x <- Q (Maybe Name)
mx
                                  case Maybe Name
x of
                                    Maybe Name
Nothing -> Maybe ([Name], [Name]) -> Q (Maybe ([Name], [Name]))
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([Name], [Name])
forall a. Maybe a
Nothing
                                    Just Name
n -> Maybe ([Name], [Name]) -> Q (Maybe ([Name], [Name]))
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([Name], [Name]) -> Q (Maybe ([Name], [Name])))
-> Maybe ([Name], [Name]) -> Q (Maybe ([Name], [Name]))
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Maybe ([Name], [Name])
forall {a}. Eq a => a -> [a] -> Maybe ([a], [a])
splitNames Name
n [Name]
targs
  where run :: Dec -> Q (Maybe Name)
        run :: Dec -> Q (Maybe Name)
run (SigD Name
_ Type
ty) = do
          Type
ty' <- Type -> Q Type
expandSyns Type
ty
          Maybe Name -> Q (Maybe Name)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> Q (Maybe Name)) -> Maybe Name -> Q (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Bool -> Type -> Maybe Name
getSig Bool
False Type
ty'
        run Dec
_ = Maybe Name -> Q (Maybe Name)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
        getSig :: Bool -> Type -> Maybe Name
getSig Bool
t (ForallT [TyVarBndr Specificity]
_ Cxt
_ Type
ty) = Bool -> Type -> Maybe Name
getSig Bool
t Type
ty
        getSig Bool
False (AppT (AppT Type
ArrowT Type
ty) Type
_) = Bool -> Type -> Maybe Name
getSig Bool
True Type
ty
        getSig Bool
True (AppT Type
ty Type
_) = Bool -> Type -> Maybe Name
getSig Bool
True Type
ty
        getSig Bool
True (VarT Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
        getSig Bool
_ Type
_ = Maybe Name
forall a. Maybe a
Nothing
        splitNames :: a -> [a] -> Maybe ([a], [a])
splitNames a
y (a
x:[a]
xs)
          | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just ([],[a]
xs)
          | Bool
otherwise = do ([a]
xs1,[a]
xs2) <- a -> [a] -> Maybe ([a], [a])
splitNames a
y [a]
xs
                           ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs1,[a]
xs2)
        splitNames a
_ [] = Maybe ([a], [a])
forall a. Maybe a
Nothing