{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
module Nix.Match.Typed
( matchNix
, matchNixLoc
, TypedMatcher(..)
, TypedMatch(..)
, get
, getOptional
, matchTyped
, findMatchesTyped
) where
import Control.Category ( (>>>) )
import Data.Coerce ( coerce )
import Data.Data
import Data.Fix
import Data.Generics.Aliases
import Data.Kind ( Constraint )
import Data.Maybe
import qualified Data.Text as T
import Data.Type.Equality ( type (==) )
import GHC.TypeLits ( ErrorMessage(..)
, KnownSymbol
, Symbol
, TypeError
, symbolVal
)
import Language.Haskell.TH ( Exp(AppE, VarE)
, ExpQ
, Pat(..)
, PatQ
, Q
, TyLit(StrTyLit)
, Type(..)
, appTypeE
, litT
, mkName
, newName
, strTyLit
, tupE
, tupP
, varE
, varP
)
import Language.Haskell.TH.Lib ( appE
, conE
)
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( dataToExpQ
, liftString
)
import Nix hiding ( TypeError )
import Nix.Match
import Nix.TH
matchNix :: QuasiQuoter
matchNix :: QuasiQuoter
matchNix = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
typedMatcherExp
, quotePat :: String -> Q Pat
quotePat = String -> Q Pat
typedMatcherPat
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "No dec quoter for typedMatcher"
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "No type quoter for typedMatcher"
}
matchNixLoc :: QuasiQuoter
matchNixLoc :: QuasiQuoter
matchNixLoc = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
typedMatcherLocExp
, quotePat :: String -> Q Pat
quotePat = String -> Q Pat
typedMatcherLocPat
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error "No dec quoter for typedMatcherLoc"
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error "No type quoter for typedMatcherLoc"
}
newtype TypedMatcher (opts :: [Symbol]) (reqs :: [Symbol]) t
= TypedMatcher {TypedMatcher opts reqs t -> WithHoles t Text
unTypedMatcher :: WithHoles t T.Text}
newtype TypedMatch (opts :: [Symbol]) (reqs :: [Symbol]) a
= TypedMatch [(T.Text, a)]
get
:: forall x opts reqs a
. (Elem "Required" x reqs, KnownSymbol x)
=> TypedMatch opts reqs a
-> a
get :: TypedMatch opts reqs a -> a
get (TypedMatch ms :: [(Text, a)]
ms) =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error "Required key not present in TypedMatch")
(Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Text
T.pack (Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall k (t :: k). Proxy t
Proxy @x))) [(Text, a)]
ms
getOptional
:: forall x opts reqs a
. (Elem "Optional" x opts, KnownSymbol x)
=> TypedMatch opts reqs a
-> Maybe a
getOptional :: TypedMatch opts reqs a -> Maybe a
getOptional (TypedMatch ms :: [(Text, a)]
ms) = Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Text
T.pack (Proxy x -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall k (t :: k). Proxy t
Proxy @x))) [(Text, a)]
ms
matchTyped
:: Matchable t
=> TypedMatcher opts reqs t
-> Fix t
-> Maybe (TypedMatch opts reqs (Fix t))
matchTyped :: TypedMatcher opts reqs t
-> Fix t -> Maybe (TypedMatch opts reqs (Fix t))
matchTyped = (WithHoles t Text -> Fix t -> Maybe [(Text, Fix t)])
-> TypedMatcher opts reqs t
-> Fix t
-> Maybe (TypedMatch opts reqs (Fix t))
forall a b. Coercible a b => a -> b
coerce WithHoles t Text -> Fix t -> Maybe [(Text, Fix t)]
forall (t :: * -> *) v.
Matchable t =>
WithHoles t v -> Fix t -> Maybe [(v, Fix t)]
match
findMatchesTyped
:: Matchable t
=> TypedMatcher opts reqs t
-> Fix t
-> [(Fix t, TypedMatch opts reqs (Fix t))]
findMatchesTyped :: TypedMatcher opts reqs t
-> Fix t -> [(Fix t, TypedMatch opts reqs (Fix t))]
findMatchesTyped = (WithHoles t Text -> Fix t -> [(Fix t, [(Text, Fix t)])])
-> TypedMatcher opts reqs t
-> Fix t
-> [(Fix t, TypedMatch opts reqs (Fix t))]
forall a b. Coercible a b => a -> b
coerce WithHoles t Text -> Fix t -> [(Fix t, [(Text, Fix t)])]
forall (t :: * -> *) v.
Matchable t =>
WithHoles t v -> Fix t -> [(Fix t, [(v, Fix t)])]
findMatches
typedMatcherExp :: String -> ExpQ
typedMatcherExp :: String -> Q Exp
typedMatcherExp =
((([Text], [Text]), Exp) -> Exp)
-> Q (([Text], [Text]), Exp) -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text], [Text]), Exp) -> Exp
forall a b. (a, b) -> b
snd (Q (([Text], [Text]), Exp) -> Q Exp)
-> (String -> Q (([Text], [Text]), Exp)) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Result NExpr)
-> (NExpr -> ([Text], [Text]))
-> (NExpr -> WithHoles NExprF Text)
-> (NExpr -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
forall a t.
Data a =>
(Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
typedMatcherGen Text -> Result NExpr
parseNixText NExpr -> ([Text], [Text])
collectHoles NExpr -> WithHoles NExprF Text
addHoles NExpr -> NExpr
forall a. a -> a
id
typedMatcherLocExp :: String -> ExpQ
typedMatcherLocExp :: String -> Q Exp
typedMatcherLocExp =
((([Text], [Text]), Exp) -> Exp)
-> Q (([Text], [Text]), Exp) -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text], [Text]), Exp) -> Exp
forall a b. (a, b) -> b
snd
(Q (([Text], [Text]), Exp) -> Q Exp)
-> (String -> Q (([Text], [Text]), Exp)) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Result NExprLoc)
-> (NExprLoc -> ([Text], [Text]))
-> (NExprLoc -> WithHoles NExprLocF Text)
-> (NExprLoc -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
forall a t.
Data a =>
(Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
typedMatcherGen Text -> Result NExprLoc
parseNixTextLoc
NExprLoc -> ([Text], [Text])
collectHolesLoc
NExprLoc -> WithHoles NExprLocF Text
addHolesLoc
NExprLoc -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation
typedMatcherPat :: String -> PatQ
typedMatcherPat :: String -> Q Pat
typedMatcherPat = (Text -> Result NExpr)
-> (NExpr -> ([Text], [Text]))
-> (NExpr -> WithHoles NExprF Text)
-> (NExpr -> NExpr)
-> String
-> Q Pat
forall a t.
Data a =>
(Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q Pat
typedMatcherPatGen Text -> Result NExpr
parseNixText NExpr -> ([Text], [Text])
collectHoles NExpr -> WithHoles NExprF Text
addHoles NExpr -> NExpr
forall a. a -> a
id
typedMatcherLocPat :: String -> PatQ
typedMatcherLocPat :: String -> Q Pat
typedMatcherLocPat =
(Text -> Result NExprLoc)
-> (NExprLoc -> ([Text], [Text]))
-> (NExprLoc -> WithHoles NExprLocF Text)
-> (NExprLoc -> NExpr)
-> String
-> Q Pat
forall a t.
Data a =>
(Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q Pat
typedMatcherPatGen Text -> Result NExprLoc
parseNixTextLoc NExprLoc -> ([Text], [Text])
collectHolesLoc NExprLoc -> WithHoles NExprLocF Text
addHolesLoc NExprLoc -> NExpr
forall (f :: * -> *) ann. Functor f => Fix (AnnF ann f) -> Fix f
stripAnnotation
typedMatcherPatGen
:: Data a
=> (T.Text -> Result t)
-> (t -> ([T.Text], [T.Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q Pat
typedMatcherPatGen :: (Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q Pat
typedMatcherPatGen parseNix :: Text -> Result t
parseNix collect :: t -> ([Text], [Text])
collect add :: t -> a
add strip :: t -> NExpr
strip s :: String
s = do
((opt :: [Text]
opt, req :: [Text]
req), matcher :: Exp
matcher) <- (Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
forall a t.
Data a =>
(Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
typedMatcherGen Text -> Result t
parseNix t -> ([Text], [Text])
collect t -> a
add t -> NExpr
strip String
s
Name
x <- String -> Q Name
newName "x"
let pat :: Q Pat
pat = [Q Pat] -> Q Pat
tupP (Name -> Q Pat
varP (Name -> Q Pat) -> (Text -> Name) -> Text -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Q Pat) -> [Text] -> [Q Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
req [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
opt))
textSymbol :: Text -> Q Type
textSymbol = TyLitQ -> Q Type
litT (TyLitQ -> Q Type) -> (Text -> TyLitQ) -> Text -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TyLitQ
strTyLit (String -> TyLitQ) -> (Text -> String) -> Text -> TyLitQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
getters :: Q Exp
getters = [Q Exp] -> Q Exp
tupE
( ((\r :: Q Type
r -> [|get @($r) $(varE x)|]) (Q Type -> Q Exp) -> (Text -> Q Type) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Q Type
textSymbol (Text -> Q Exp) -> [Text] -> [Q Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
req)
[Q Exp] -> [Q Exp] -> [Q Exp]
forall a. Semigroup a => a -> a -> a
<> ((\o :: Q Type
o -> [|getOptional @($o) $(varE x)|]) (Q Type -> Q Exp) -> (Text -> Q Type) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Q Type
textSymbol (Text -> Q Exp) -> [Text] -> [Q Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
opt)
)
[p|(fmap (\ $(varP x) -> $getters) . matchTyped $(pure matcher) -> Just $pat)|]
typedMatcherGen
:: Data a
=> (T.Text -> Result t)
-> (t -> ([T.Text], [T.Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([T.Text], [T.Text]), Exp)
typedMatcherGen :: (Text -> Result t)
-> (t -> ([Text], [Text]))
-> (t -> a)
-> (t -> NExpr)
-> String
-> Q (([Text], [Text]), Exp)
typedMatcherGen parseNix :: Text -> Result t
parseNix collect :: t -> ([Text], [Text])
collect add :: t -> a
add strip :: t -> NExpr
strip s :: String
s = do
t
expr <- case Text -> Result t
parseNix (String -> Text
T.pack String
s) of
Failure err :: Doc Void
err -> String -> Q t
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q t) -> String -> Q t
forall a b. (a -> b) -> a -> b
$ Doc Void -> String
forall a. Show a => a -> String
show Doc Void
err
Success e :: t
e -> t -> Q t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
e
let (opt :: [Text]
opt, req :: [Text]
req) = t -> ([Text], [Text])
collect t
expr
optT :: Type
optT = [Text] -> Type
symbolList [Text]
opt
reqT :: Type
reqT = [Text] -> Type
symbolList [Text]
req
holed :: a
holed = t -> a
add t
expr
exprExp :: Q Exp
exprExp = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
dataToExpQ
( Maybe (Q Exp) -> b -> Maybe (Q Exp)
forall a b. a -> b -> a
const Maybe (Q Exp)
forall a. Maybe a
Nothing
(b -> Maybe (Q Exp))
-> (NExprLoc -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Set Text -> NExprLoc -> Maybe (Q Exp)
metaExp (NExpr -> Set Text
freeVars (t -> NExpr
strip t
expr))
(b -> Maybe (Q Exp))
-> (Text -> Maybe (Q Exp)) -> b -> Maybe (Q Exp)
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Text -> Q Exp) -> Text -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Q Exp
liftText)
)
a
holed
Exp
e <-
Name -> Q Exp
conE 'TypedMatcher Q Exp -> Q Type -> Q Exp
`appTypeE` Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
optT Q Exp -> Q Type -> Q Exp
`appTypeE` Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
reqT Q Exp -> Q Exp -> Q Exp
`appE` Q Exp
exprExp
(([Text], [Text]), Exp) -> Q (([Text], [Text]), Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Text]
opt, [Text]
req), Exp
e)
liftText :: T.Text -> Q Exp
liftText :: Text -> Q Exp
liftText txt :: Text
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'T.pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
liftString (Text -> String
T.unpack Text
txt)
symbolList :: [T.Text] -> Type
symbolList :: [Text] -> Type
symbolList = (Text -> Type -> Type) -> Type -> [Text] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\n :: Text
n -> (Type
PromotedConsT Type -> Type -> Type
`AppT` TyLit -> Type
LitT (String -> TyLit
StrTyLit (Text -> String
T.unpack Text
n)) Type -> Type -> Type
`AppT`))
Type
PromotedNilT
collectHoles :: NExpr -> ([T.Text], [T.Text])
collectHoles :: NExpr -> ([Text], [Text])
collectHoles = NExpr -> NExprF NExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (NExpr -> NExprF NExpr)
-> (NExprF NExpr -> ([Text], [Text])) -> NExpr -> ([Text], [Text])
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
NSynHole n :: Text
n -> ([], [Text
n])
NSet _ bs :: [Binding NExpr]
bs -> (Binding NExpr -> ([Text], [Text]))
-> [Binding NExpr] -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((NExpr -> ([Text], [Text])) -> Binding NExpr -> ([Text], [Text])
forall r a. (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles NExpr -> ([Text], [Text])
collectHoles) [Binding NExpr]
bs
NLet bs :: [Binding NExpr]
bs e :: NExpr
e -> NExpr -> ([Text], [Text])
collectHoles NExpr
e ([Text], [Text]) -> ([Text], [Text]) -> ([Text], [Text])
forall a. Semigroup a => a -> a -> a
<> (Binding NExpr -> ([Text], [Text]))
-> [Binding NExpr] -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((NExpr -> ([Text], [Text])) -> Binding NExpr -> ([Text], [Text])
forall r a. (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles NExpr -> ([Text], [Text])
collectHoles) [Binding NExpr]
bs
e :: NExprF NExpr
e -> (NExpr -> ([Text], [Text])) -> NExprF NExpr -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NExpr -> ([Text], [Text])
collectHoles NExprF NExpr
e
collectHolesLoc :: NExprLoc -> ([T.Text], [T.Text])
collectHolesLoc :: NExprLoc -> ([Text], [Text])
collectHolesLoc = NExprLoc -> NExprLocF NExprLoc
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (NExprLoc -> NExprLocF NExprLoc)
-> (NExprLocF NExprLoc -> ([Text], [Text]))
-> NExprLoc
-> ([Text], [Text])
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
Compose (Ann _ (NSynHole n :: Text
n)) -> ([], [Text
n])
Compose (Ann _ (NSet _ bs :: [Binding NExprLoc]
bs )) -> (Binding NExprLoc -> ([Text], [Text]))
-> [Binding NExprLoc] -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((NExprLoc -> ([Text], [Text]))
-> Binding NExprLoc -> ([Text], [Text])
forall r a. (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles NExprLoc -> ([Text], [Text])
collectHolesLoc) [Binding NExprLoc]
bs
Compose (Ann _ (NLet bs :: [Binding NExprLoc]
bs e :: NExprLoc
e)) ->
NExprLoc -> ([Text], [Text])
collectHolesLoc NExprLoc
e ([Text], [Text]) -> ([Text], [Text]) -> ([Text], [Text])
forall a. Semigroup a => a -> a -> a
<> (Binding NExprLoc -> ([Text], [Text]))
-> [Binding NExprLoc] -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((NExprLoc -> ([Text], [Text]))
-> Binding NExprLoc -> ([Text], [Text])
forall r a. (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles NExprLoc -> ([Text], [Text])
collectHolesLoc) [Binding NExprLoc]
bs
e :: NExprLocF NExprLoc
e -> (NExprLoc -> ([Text], [Text]))
-> NExprLocF NExprLoc -> ([Text], [Text])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NExprLoc -> ([Text], [Text])
collectHolesLoc NExprLocF NExprLoc
e
bindingHoles :: (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles :: (r -> ([a], [a])) -> Binding r -> ([a], [a])
bindingHoles f :: r -> ([a], [a])
f = \case
b :: Binding r
b@(NamedVar p :: NAttrPath r
p _ _) | Maybe (NAttrPath r) -> Bool
forall a. Maybe a -> Bool
isJust (NAttrPath r -> Maybe (NAttrPath r)
forall r. NAttrPath r -> Maybe (NAttrPath r)
isOptionalPath NAttrPath r
p) ->
let (opt :: [a]
opt, req :: [a]
req) = (r -> ([a], [a])) -> Binding r -> ([a], [a])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap r -> ([a], [a])
f Binding r
b in ([a]
opt [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
req, [])
b :: Binding r
b -> (r -> ([a], [a])) -> Binding r -> ([a], [a])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap r -> ([a], [a])
f Binding r
b
type family Bool' (f :: k) (t :: k) (x :: Bool) :: k where
Bool' f _ 'False = f
Bool' _ t 'True = t
type family Elem n x ys :: Constraint where
Elem n x '[] = TypeError ('Text n ':<>: 'Text " key \"" ':<>: 'Text x ':<>: 'Text "\" not found in TypedMatch")
Elem n x (y:ys) = Bool' (Elem n x ys) (() :: Constraint) (x == y)