{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | This module contains mechanisms for deriving necessary instances for a new 'Effect' typeclass to work with -- @avail@. If you only need functionalities from @mtl@, @monad-control@, @unliftio@ and @capability@, you don't need -- to use this module. -- -- You need these extensions when using the module: -- -- @ -- DataKinds -- DerivingStrategies -- FlexibleContexts -- FlexibleInstances -- GeneralizedNewtypeDeriving -- StandaloneDeriving -- TemplateHaskell -- TypeFamilies -- UndecidableInstances -- @ module Avail.Derive ( -- * Deriving avail, avail' , -- * Helpers for deriving instances for multi-param classes with1, with2, with3, with4, with5, withN, with1', with2', with3', with4', with5', withN' , -- * Necessary reexports - do not use directly M (UnsafeLift) ) where import Avail.Internal import Language.Haskell.TH hiding (Type) import qualified Language.Haskell.TH as TH -- | Derive necessary instances for an 'Effect' typeclass to work with @avail@. Specifically, this only works with -- typeclasses without superclasses; see 'avail'' for a version that takes care of superclasses. avail :: Q TH.Type -> Q [Dec] avail :: Q Type -> Q [Dec] avail = [Q Type] -> Q Type -> Q [Dec] avail' [] -- | Derive necessary instances for an 'Effect' typeclass to work with @avail@. This is a generalized version of -- 'avail' that allows you to pass in a list of superclasses. -- -- For superclasses @Sup :: ['Effect']@ and current class @Cls :: 'Effect'@, the code generated is: -- -- @ -- instance 'IsEff' Cls where -- type 'Superclasses' Cls = Sup -- deriving newtype instance (Cls m, 'Eff' Cls) => Cls ('M' m) -- @ -- -- Although this is very little code, it is still boilerplate and defining them by hand is error-prone. Therefore, -- /please/ do not define instances for 'M' by hand (except when doing dirty hacks); use this function instead. avail' :: [Q TH.Type] -> Q TH.Type -> Q [Dec] avail' :: [Q Type] -> Q Type -> Q [Dec] avail' = (Q Type -> Q Type) -> [Q Type] -> Q Type -> Q [Dec] avail'' ((Q Type -> Q Type) -> [Q Type] -> Q Type -> Q [Dec]) -> (Q Type -> Q Type) -> [Q Type] -> Q Type -> Q [Dec] forall a b. (a -> b) -> a -> b $ \Q Type m -> [t| M $m |] avail'' :: (Q TH.Type -> Q TH.Type) -> [Q TH.Type] -> Q TH.Type -> Q [Dec] avail'' :: (Q Type -> Q Type) -> [Q Type] -> Q Type -> Q [Dec] avail'' Q Type -> Q Type mm [Q Type] pre Q Type cls = do Name mName <- String -> Q Name newName String "m" let m :: Q Type m = Type -> Q Type forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> Q Type) -> Type -> Q Type forall a b. (a -> b) -> a -> b $ Name -> Type VarT Name mName [d| instance IsEff $cls where type Superclasses $cls = $(makeList <$> sequence pre) deriving newtype instance ($cls $m, Eff $cls) => $cls $(mm m) |] where makeList :: [Type] -> Type makeList [] = Type PromotedNilT makeList (Type x : [Type] xs) = Type PromotedConsT Type -> Type -> Type `AppT` Type x Type -> Type -> Type `AppT` [Type] -> Type makeList [Type] xs -- | Introduce one type variable @a@. with1 :: (Q TH.Type -> Q a) -> Q a with1 :: (Q Type -> Q a) -> Q a with1 = String -> (Q Type -> Q a) -> Q a forall a. String -> (Q Type -> Q a) -> Q a with1' String "a" -- | Introduce one type variable with given name. with1' :: String -> (Q TH.Type -> Q a) -> Q a with1' :: String -> (Q Type -> Q a) -> Q a with1' String n Q Type -> Q a f = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' [String n] (\[Q Type a] -> Q Type -> Q a f Q Type a) -- | Introduce two type variables @a, b@. with2 :: (Q TH.Type -> Q TH.Type -> Q a) -> Q a with2 :: (Q Type -> Q Type -> Q a) -> Q a with2 = String -> String -> (Q Type -> Q Type -> Q a) -> Q a forall a. String -> String -> (Q Type -> Q Type -> Q a) -> Q a with2' String "a" String "b" -- | Introduce two type variables with given names. with2' :: String -> String -> (Q TH.Type -> Q TH.Type -> Q a) -> Q a with2' :: String -> String -> (Q Type -> Q Type -> Q a) -> Q a with2' String n1 String n2 Q Type -> Q Type -> Q a f = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' [String n1, String n2] (\[Q Type a, Q Type b] -> Q Type -> Q Type -> Q a f Q Type a Q Type b) -- | Introduce three type variables @a, b, c@. with3 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with3 :: (Q Type -> Q Type -> Q Type -> Q a) -> Q a with3 = String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q a) -> Q a forall a. String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q a) -> Q a with3' String "a" String "b" String "c" -- | Introduce three type variables with given names. with3' :: String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with3' :: String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q a) -> Q a with3' String n1 String n2 String n3 Q Type -> Q Type -> Q Type -> Q a f = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' [String n1, String n2, String n3] (\[Q Type a, Q Type b, Q Type c] -> Q Type -> Q Type -> Q Type -> Q a f Q Type a Q Type b Q Type c) -- | Introduce four type variables @a, b, c, d@. with4 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with4 :: (Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with4 = String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a forall a. String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with4' String "a" String "b" String "c" String "d" -- | Introduce four type variables with given names. with4' :: String -> String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with4' :: String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with4' String n1 String n2 String n3 String n4 Q Type -> Q Type -> Q Type -> Q Type -> Q a f = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' [String n1, String n2, String n3, String n4] (\[Q Type a, Q Type b, Q Type c, Q Type d] -> Q Type -> Q Type -> Q Type -> Q Type -> Q a f Q Type a Q Type b Q Type c Q Type d) -- | Introduce five type variables @a, b, c, d, e@. with5 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with5 :: (Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with5 = String -> String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a forall a. String -> String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with5' String "a" String "b" String "c" String "d" String "e" -- | Introduce five type variables with given names. with5' :: String -> String -> String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a with5' :: String -> String -> String -> String -> String -> (Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a) -> Q a with5' String n1 String n2 String n3 String n4 String n5 Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a f = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' [String n1, String n2, String n3, String n4, String n5] (\[Q Type a, Q Type b, Q Type c, Q Type d, Q Type e] -> Q Type -> Q Type -> Q Type -> Q Type -> Q Type -> Q a f Q Type a Q Type b Q Type c Q Type d Q Type e) -- | Introduce arbitrarily many type variables @a1, a2, a3, ...@. withN :: Int -> ([Q TH.Type] -> Q a) -> Q a withN :: Int -> ([Q Type] -> Q a) -> Q a withN Int n = [String] -> ([Q Type] -> Q a) -> Q a forall a. [String] -> ([Q Type] -> Q a) -> Q a withN' ([String] -> ([Q Type] -> Q a) -> Q a) -> [String] -> ([Q Type] -> Q a) -> Q a forall a b. (a -> b) -> a -> b $ (Char 'a' Char -> String -> String forall a. a -> [a] -> [a] :) (String -> String) -> (Int -> String) -> Int -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> String forall a. Show a => a -> String show (Int -> String) -> [Int] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Int 1..Int n] -- | Introduce arbitrarily many type variables with given names. withN' :: [String] -> ([Q TH.Type] -> Q a) -> Q a withN' :: [String] -> ([Q Type] -> Q a) -> Q a withN' [String] n [Q Type] -> Q a f = do [Type] as <- (String -> Q Type) -> [String] -> Q [Type] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ((Name -> Type) -> Q Name -> Q Type forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name -> Type VarT (Q Name -> Q Type) -> (String -> Q Name) -> String -> Q Type forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Q Name newName) [String] n [Q Type] -> Q a f (Type -> Q Type forall (f :: * -> *) a. Applicative f => a -> f a pure (Type -> Q Type) -> [Type] -> [Q Type] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Type] as)