{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}

module Data.Aeson.TypeScript.Recursive (
  -- * Getting declarations recursively
  getTransitiveClosure
  , getTypeScriptDeclarationsRecursively

  -- * Deriving missing instances recursively
  , recursivelyDeriveMissingTypeScriptInstancesFor
  , recursivelyDeriveMissingInstancesFor
  , deriveInstanceIfNecessary
  , doesTypeScriptInstanceExist
  , getAllParentTypes
  ) where

import Control.Monad.State
import Control.Monad.Trans.Maybe
import Control.Monad.Writer
import Data.Aeson.TypeScript.Instances ()
import Data.Aeson.TypeScript.TH
import Data.Bifunctor
import Data.Function
import qualified Data.List as L
import Data.Maybe
import Data.Proxy
import qualified Data.Set as S
import Data.String.Interpolate
import Language.Haskell.TH as TH
import Language.Haskell.TH.Datatype
import Language.Haskell.TH.Syntax hiding (lift)


getTransitiveClosure :: S.Set TSType -> S.Set TSType
getTransitiveClosure :: Set TSType -> Set TSType
getTransitiveClosure = ((Set TSType -> Set TSType) -> Set TSType -> Set TSType)
-> Set TSType -> Set TSType
forall a. (a -> a) -> a
fix (((Set TSType -> Set TSType) -> Set TSType -> Set TSType)
 -> Set TSType -> Set TSType)
-> ((Set TSType -> Set TSType) -> Set TSType -> Set TSType)
-> Set TSType
-> Set TSType
forall a b. (a -> b) -> a -> b
$ \Set TSType -> Set TSType
loop Set TSType
items ->
  let items' :: Set TSType
items' = [Set TSType] -> Set TSType
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (Set TSType
items Set TSType -> [Set TSType] -> [Set TSType]
forall a. a -> [a] -> [a]
: [TSType -> Set TSType
getMore TSType
x | TSType
x <- Set TSType -> [TSType]
forall a. Set a -> [a]
S.toList Set TSType
items])
   in if
          | Set TSType
items' Set TSType -> Set TSType -> Bool
forall a. Eq a => a -> a -> Bool
== Set TSType
items -> Set TSType
items
          | Bool
otherwise -> Set TSType -> Set TSType
loop Set TSType
items'

  where getMore :: TSType -> S.Set TSType
        getMore :: TSType -> Set TSType
getMore (TSType Proxy a
x) = [TSType] -> Set TSType
forall a. Ord a => [a] -> Set a
S.fromList ([TSType] -> Set TSType) -> [TSType] -> Set TSType
forall a b. (a -> b) -> a -> b
$ Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes Proxy a
x

getTypeScriptDeclarationsRecursively :: (TypeScript a) => Proxy a -> [TSDeclaration]
getTypeScriptDeclarationsRecursively :: Proxy a -> [TSDeclaration]
getTypeScriptDeclarationsRecursively Proxy a
initialType = Set TSDeclaration -> [TSDeclaration]
forall a. Set a -> [a]
S.toList (Set TSDeclaration -> [TSDeclaration])
-> Set TSDeclaration -> [TSDeclaration]
forall a b. (a -> b) -> a -> b
$ [TSDeclaration] -> Set TSDeclaration
forall a. Ord a => [a] -> Set a
S.fromList [TSDeclaration]
declarations
  where
    closure :: Set TSType
closure = Set TSType -> Set TSType
getTransitiveClosure ([TSType] -> Set TSType
forall a. Ord a => [a] -> Set a
S.fromList [Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType Proxy a
initialType])
    declarations :: [TSDeclaration]
declarations = [[TSDeclaration]] -> [TSDeclaration]
forall a. Monoid a => [a] -> a
mconcat [Proxy a -> [TSDeclaration]
forall k (a :: k). TypeScript a => Proxy a -> [TSDeclaration]
getTypeScriptDeclarations Proxy a
x | TSType Proxy a
x <- Set TSType -> [TSType]
forall a. Set a -> [a]
S.toList Set TSType
closure]


-- * Recursively deriving missing TypeScript interfaces

recursivelyDeriveMissingTypeScriptInstancesFor :: (Monoid w) => Name -> (Name -> Q w) -> Q w
recursivelyDeriveMissingTypeScriptInstancesFor :: Name -> (Name -> Q w) -> Q w
recursivelyDeriveMissingTypeScriptInstancesFor = (Name -> Q Bool) -> Name -> (Name -> Q w) -> Q w
forall w.
Monoid w =>
(Name -> Q Bool) -> Name -> (Name -> Q w) -> Q w
recursivelyDeriveMissingInstancesFor Name -> Q Bool
doesTypeScriptInstanceExist

recursivelyDeriveMissingInstancesFor :: (Monoid w) => (Name -> Q Bool) -> Name -> (Name -> Q w) -> Q w
recursivelyDeriveMissingInstancesFor :: (Name -> Q Bool) -> Name -> (Name -> Q w) -> Q w
recursivelyDeriveMissingInstancesFor Name -> Q Bool
doesInstanceExist Name
name Name -> Q w
deriveFn = WriterT w Q () -> Q w
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT w Q () -> Q w) -> WriterT w Q () -> Q w
forall a b. (a -> b) -> a -> b
$ do
  Name -> (Name -> Q w) -> WriterT w Q ()
forall w. Monoid w => Name -> (Name -> Q w) -> WriterT w Q ()
deriveInstanceIfNecessary Name
name Name -> Q w
deriveFn

  [Name]
names <- Q [Name] -> WriterT w Q [Name]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Name] -> WriterT w Q [Name]) -> Q [Name] -> WriterT w Q [Name]
forall a b. (a -> b) -> a -> b
$ Name -> (Name -> Q Bool) -> Q [Name]
getAllParentTypes Name
name Name -> Q Bool
doesInstanceExist
  [Name] -> (Name -> WriterT w Q ()) -> WriterT w Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names ((Name -> WriterT w Q ()) -> WriterT w Q ())
-> (Name -> WriterT w Q ()) -> WriterT w Q ()
forall a b. (a -> b) -> a -> b
$ \Name
n -> Name -> (Name -> Q w) -> WriterT w Q ()
forall w. Monoid w => Name -> (Name -> Q w) -> WriterT w Q ()
deriveInstanceIfNecessary Name
n Name -> Q w
deriveFn

deriveInstanceIfNecessary :: (Monoid w) => Name -> (Name -> Q w) -> WriterT w Q ()
deriveInstanceIfNecessary :: Name -> (Name -> Q w) -> WriterT w Q ()
deriveInstanceIfNecessary Name
name Name -> Q w
deriveFn = do
  Q Bool -> WriterT w Q Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Name -> Q Bool
doesTypeScriptInstanceExist Name
name) WriterT w Q Bool -> (Bool -> WriterT w Q ()) -> WriterT w Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> () -> WriterT w Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool
False -> do
      (Q (Maybe w) -> WriterT w Q (Maybe w)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q (Maybe w) -> WriterT w Q (Maybe w))
-> Q (Maybe w) -> WriterT w Q (Maybe w)
forall a b. (a -> b) -> a -> b
$ Q w -> Q (Maybe w)
forall a. Q a -> Q (Maybe a)
nothingOnFail (Name -> Q w
deriveFn Name
name)) WriterT w Q (Maybe w)
-> (Maybe w -> WriterT w Q ()) -> WriterT w Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe w
Nothing -> Q () -> WriterT w Q ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q () -> WriterT w Q ()) -> Q () -> WriterT w Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
reportWarning [i|Failed to derive decls for name '#{name}'|]
        Just w
x -> w -> WriterT w Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
x

doesTypeScriptInstanceExist :: Name -> Q Bool
doesTypeScriptInstanceExist :: Name -> Q Bool
doesTypeScriptInstanceExist Name
name = do
  Maybe Bool
result :: Maybe Bool <- MaybeT Q Bool -> Q (Maybe Bool)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Q Bool -> Q (Maybe Bool))
-> MaybeT Q Bool -> Q (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
    (DatatypeInfo {[Type]
[TyVarBndrUnit]
[ConstructorInfo]
Name
DatatypeVariant
datatypeContext :: DatatypeInfo -> [Type]
datatypeName :: DatatypeInfo -> Name
datatypeVars :: DatatypeInfo -> [TyVarBndrUnit]
datatypeInstTypes :: DatatypeInfo -> [Type]
datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeCons :: DatatypeInfo -> [ConstructorInfo]
datatypeCons :: [ConstructorInfo]
datatypeVariant :: DatatypeVariant
datatypeInstTypes :: [Type]
datatypeVars :: [TyVarBndrUnit]
datatypeName :: Name
datatypeContext :: [Type]
..}) <- Q (Maybe DatatypeInfo) -> MaybeT Q DatatypeInfo
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Q (Maybe DatatypeInfo) -> MaybeT Q DatatypeInfo)
-> Q (Maybe DatatypeInfo) -> MaybeT Q DatatypeInfo
forall a b. (a -> b) -> a -> b
$ Q DatatypeInfo -> Q (Maybe DatatypeInfo)
forall a. Q a -> Q (Maybe a)
nothingOnFail (Q DatatypeInfo -> Q (Maybe DatatypeInfo))
-> Q DatatypeInfo -> Q (Maybe DatatypeInfo)
forall a b. (a -> b) -> a -> b
$ Name -> Q DatatypeInfo
reifyDatatype Name
name

    -- Skip names with type parameters for now
    Bool -> MaybeT Q () -> MaybeT Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TyVarBndrUnit]
datatypeVars [TyVarBndrUnit] -> [TyVarBndrUnit] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (MaybeT Q () -> MaybeT Q ()) -> MaybeT Q () -> MaybeT Q ()
forall a b. (a -> b) -> a -> b
$ String -> MaybeT Q ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""

    Q (Maybe Bool) -> MaybeT Q Bool
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Q (Maybe Bool) -> MaybeT Q Bool)
-> Q (Maybe Bool) -> MaybeT Q Bool
forall a b. (a -> b) -> a -> b
$ Q Bool -> Q (Maybe Bool)
forall a. Q a -> Q (Maybe a)
nothingOnFail (Q Bool -> Q (Maybe Bool)) -> Q Bool -> Q (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Name -> [Type] -> Q Bool
isInstance ''TypeScript [Name -> Type
ConT Name
name]

  Bool -> Q Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Q Bool) -> Bool -> Q Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
result

getAllParentTypes :: Name -> (Name -> Q Bool) -> Q [Name]
getAllParentTypes :: Name -> (Name -> Q Bool) -> Q [Name]
getAllParentTypes Name
name Name -> Q Bool
pruneFn = [Name] -> [Name]
forall a. [a] -> [a]
reverse ([Name] -> [Name]) -> Q [Name] -> Q [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [Name] Q () -> [Name] -> Q [Name]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (Name -> (Name -> Q Bool) -> StateT [Name] Q ()
getAllParentTypes' Name
name Name -> Q Bool
pruneFn) []
  where
    getAllParentTypes' :: Name -> (Name -> Q Bool) -> StateT [Name] Q ()
    getAllParentTypes' :: Name -> (Name -> Q Bool) -> StateT [Name] Q ()
getAllParentTypes' Name
nm Name -> Q Bool
pfn = (Q (Maybe Bool) -> StateT [Name] Q (Maybe Bool)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q (Maybe Bool) -> StateT [Name] Q (Maybe Bool))
-> Q (Maybe Bool) -> StateT [Name] Q (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Q Bool -> Q (Maybe Bool)
forall a. Q a -> Q (Maybe a)
nothingOnFail (Q Bool -> Q (Maybe Bool)) -> Q Bool -> Q (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Name -> Q Bool
pfn Name
nm) StateT [Name] Q (Maybe Bool)
-> (Maybe Bool -> StateT [Name] Q ()) -> StateT [Name] Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Bool
Nothing -> () -> StateT [Name] Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Bool
True -> () -> StateT [Name] Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Bool
False -> (Q (Maybe DatatypeInfo) -> StateT [Name] Q (Maybe DatatypeInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q (Maybe DatatypeInfo) -> StateT [Name] Q (Maybe DatatypeInfo))
-> Q (Maybe DatatypeInfo) -> StateT [Name] Q (Maybe DatatypeInfo)
forall a b. (a -> b) -> a -> b
$ Q DatatypeInfo -> Q (Maybe DatatypeInfo)
forall a. Q a -> Q (Maybe a)
nothingOnFail (Name -> Q DatatypeInfo
reifyDatatype Name
nm)) StateT [Name] Q (Maybe DatatypeInfo)
-> (Maybe DatatypeInfo -> StateT [Name] Q ()) -> StateT [Name] Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe DatatypeInfo
Nothing -> do
          Q () -> StateT [Name] Q ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q () -> StateT [Name] Q ()) -> Q () -> StateT [Name] Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
reportWarning [i|Failed to reify: '#{nm}'|]
        Just (DatatypeInfo {[Type]
[TyVarBndrUnit]
[ConstructorInfo]
Name
DatatypeVariant
datatypeCons :: [ConstructorInfo]
datatypeVariant :: DatatypeVariant
datatypeInstTypes :: [Type]
datatypeVars :: [TyVarBndrUnit]
datatypeName :: Name
datatypeContext :: [Type]
datatypeContext :: DatatypeInfo -> [Type]
datatypeName :: DatatypeInfo -> Name
datatypeVars :: DatatypeInfo -> [TyVarBndrUnit]
datatypeInstTypes :: DatatypeInfo -> [Type]
datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeCons :: DatatypeInfo -> [ConstructorInfo]
..}) -> do
          let parentTypes :: [Type]
parentTypes = [[Type]] -> [Type]
forall a. Monoid a => [a] -> a
mconcat ([[Type]] -> [Type]) -> [[Type]] -> [Type]
forall a b. (a -> b) -> a -> b
$ (ConstructorInfo -> [Type]) -> [ConstructorInfo] -> [[Type]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorInfo -> [Type]
constructorFields [ConstructorInfo]
datatypeCons

          let maybeRecurse :: Name -> StateT [Name] Q ()
maybeRecurse Name
n = do
                [Name]
st <- StateT [Name] Q [Name]
forall s (m :: * -> *). MonadState s m => m s
get
                Bool -> StateT [Name] Q () -> StateT [Name] Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Name]
st) (StateT [Name] Q () -> StateT [Name] Q ())
-> StateT [Name] Q () -> StateT [Name] Q ()
forall a b. (a -> b) -> a -> b
$ do
                  ([Name] -> [Name]) -> StateT [Name] Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:)
                  Name -> (Name -> Q Bool) -> StateT [Name] Q ()
getAllParentTypes' Name
n Name -> Q Bool
pfn

          [Type] -> (Type -> StateT [Name] Q ()) -> StateT [Name] Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Type]
parentTypes ((Type -> StateT [Name] Q ()) -> StateT [Name] Q ())
-> (Type -> StateT [Name] Q ()) -> StateT [Name] Q ()
forall a b. (a -> b) -> a -> b
$ \Type
typ -> do
            let [Name]
names :: [Name] = ([Name], [Type]) -> [Name]
forall a b. (a, b) -> a
fst (([Name], [Type]) -> [Name]) -> ([Name], [Type]) -> [Name]
forall a b. (a -> b) -> a -> b
$ State ([Name], [Type]) () -> ([Name], [Type]) -> ([Name], [Type])
forall s a. State s a -> s -> s
execState (Type -> State ([Name], [Type]) ()
getNamesFromType Type
typ) ([], [Type
typ])
            [Name] -> (Name -> StateT [Name] Q ()) -> StateT [Name] Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names Name -> StateT [Name] Q ()
maybeRecurse

    getNamesFromType :: Type -> State ([Name], [Type]) ()
    getNamesFromType :: Type -> State ([Name], [Type]) ()
getNamesFromType (ConT Name
n) = (([Name], [Type]) -> ([Name], [Type])) -> State ([Name], [Type]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Name] -> [Name]) -> ([Name], [Type]) -> ([Name], [Type])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (([Name] -> [Name]) -> ([Name], [Type]) -> ([Name], [Type]))
-> ([Name] -> [Name]) -> ([Name], [Type]) -> ([Name], [Type])
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> [Name]
forall a. Eq a => a -> [a] -> [a]
addIfNotPresent Name
n)
    getNamesFromType (AppT Type
t1 Type
t2) = Type -> Type -> State ([Name], [Type]) ()
handleTwoTypes Type
t1 Type
t2
    getNamesFromType (InfixT Type
t1 Name
_ Type
t2) = Type -> Type -> State ([Name], [Type]) ()
handleTwoTypes Type
t1 Type
t2
    getNamesFromType (UInfixT Type
t1 Name
_ Type
t2) = Type -> Type -> State ([Name], [Type]) ()
handleTwoTypes Type
t1 Type
t2
    getNamesFromType Type
_ = () -> State ([Name], [Type]) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    handleTwoTypes :: Type -> Type -> State ([Name], [Type]) ()
handleTwoTypes Type
t1 Type
t2 = do
      ([Name]
_, [Type]
visitedTypes) <- StateT ([Name], [Type]) Identity ([Name], [Type])
forall s (m :: * -> *). MonadState s m => m s
get
      Bool -> State ([Name], [Type]) () -> State ([Name], [Type]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Type
t1 Type -> [Type] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Type]
visitedTypes) (State ([Name], [Type]) () -> State ([Name], [Type]) ())
-> State ([Name], [Type]) () -> State ([Name], [Type]) ()
forall a b. (a -> b) -> a -> b
$ do
        (([Name], [Type]) -> ([Name], [Type])) -> State ([Name], [Type]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Type] -> [Type]) -> ([Name], [Type]) -> ([Name], [Type])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type
t1 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:))
        Type -> State ([Name], [Type]) ()
getNamesFromType Type
t1

      ([Name]
_, [Type]
visitedTypes') <- StateT ([Name], [Type]) Identity ([Name], [Type])
forall s (m :: * -> *). MonadState s m => m s
get
      Bool -> State ([Name], [Type]) () -> State ([Name], [Type]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Type
t2 Type -> [Type] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Type]
visitedTypes') (State ([Name], [Type]) () -> State ([Name], [Type]) ())
-> State ([Name], [Type]) () -> State ([Name], [Type]) ()
forall a b. (a -> b) -> a -> b
$ do
        (([Name], [Type]) -> ([Name], [Type])) -> State ([Name], [Type]) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Type] -> [Type]) -> ([Name], [Type]) -> ([Name], [Type])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type
t2 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:))
        Type -> State ([Name], [Type]) ()
getNamesFromType Type
t2

    addIfNotPresent :: (Eq a) => a -> [a] -> [a]
    addIfNotPresent :: a -> [a] -> [a]
addIfNotPresent a
x [a]
xs | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [a]
xs = [a]
xs
    addIfNotPresent a
x [a]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs

nothingOnFail :: Q a -> Q (Maybe a)
nothingOnFail :: Q a -> Q (Maybe a)
nothingOnFail Q a
action = Q (Maybe a) -> Q (Maybe a) -> Q (Maybe a)
forall a. Q a -> Q a -> Q a
recover (Maybe a -> Q (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Q a -> Q (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q a
action)