constraints-extras 0.2.3.1 → 0.2.3.2

raw patch · 7 files changed

+70/−35 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.lhs +1/−1
• README.md +1/−1
• constraints-extras.cabal +7/−2
• src/Data/Constraint/Compose.hs +18/−0
• src/Data/Constraint/Extras.hs +23/−12
• src/Data/Constraint/Extras/TH.hs +2/−19
• src/Data/Constraint/Flip.hs +18/−0

@@ -33,7 +33,7 @@  deriveArgDict ''A deriveArgDict ''B-deriveArgDictV ''V+deriveArgDict ''V  data DSum k f = forall a. DSum (k a) (f a) 

@@ -33,7 +33,7 @@  deriveArgDict ''A deriveArgDict ''B-deriveArgDictV ''V+deriveArgDict ''V  data DSum k f = forall a. DSum (k a) (f a) 

@@ -1,5 +1,5 @@ name: constraints-extras-version: 0.2.3.1+version: 0.2.3.2 synopsis: Utility package for constraints description: Convenience functions and TH for working with constraints. See <https://github.com/obsidiansystems/constraints-extras/blob/develop/README.md README.md> for example usage. category: Constraints@@ -13,7 +13,10 @@ extra-source-files: README.md  library-  exposed-modules: Data.Constraint.Extras, Data.Constraint.Extras.TH+  exposed-modules: Data.Constraint.Extras+                 , Data.Constraint.Extras.TH+                 , Data.Constraint.Compose+  other-modules: Data.Constraint.Flip   other-extensions: LambdaCase                   , MultiParamTypeClasses                   , QuasiQuotes@@ -28,6 +31,8 @@   default-language: Haskell2010  executable readme+  if impl(ghcjs)+    buildable: False   build-depends: base >=4.9 && <4.12                , aeson                , constraints >= 0.9 && < 0.11

@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE UndecidableSuperClasses #-}+#endif++module Data.Constraint.Compose+  ( ComposeC+  ) where++import Data.Constraint++-- | Composition for constraints.+class p (f a) => ComposeC (p :: k2 -> Constraint) (f :: k1 -> k2) (a :: k1)+instance p (f a) => ComposeC p f a

@@ -1,16 +1,20 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}  module Data.Constraint.Extras where  import Data.Constraint+import Data.Constraint.Compose+import Data.Constraint.Flip import Data.Constraint.Forall  -- | Morally, this class is for GADTs whose indices can be finitely enumerated. It provides operations which will@@ -24,18 +28,25 @@ -- want to go quite that far at the time of writing. class ArgDict f where   type ConstraintsFor f (c :: k -> Constraint) :: Constraint-  type ConstraintsFor' f (c :: k -> Constraint) (g :: k' -> k) :: Constraint   argDict :: ConstraintsFor f c => f a -> Dict (c a)-  argDict' :: ConstraintsFor' f c g => f a -> Dict (c (g a)) --- | This places a tighter restriction on the kind of f, and so needs to be a separate class.-class ArgDictV f where-  type ConstraintsForV (f :: (k -> k') -> *) (c :: k' -> Constraint) (g :: k) :: Constraint-  argDictV :: ConstraintsForV f c g => f v -> Dict (c (v g))+type ConstraintsFor' f (c :: k -> Constraint) (g :: k' -> k) = ConstraintsFor f (ComposeC c g) +argDict' :: forall f c g a. (ArgDict f, ConstraintsFor' f c g) => f a -> Dict (c (g a))+argDict' tag = case argDict tag of+  (Dict :: Dict (ComposeC c g a)) -> Dict+type ConstraintsForV (f :: (k -> k') -> *) (c :: k' -> Constraint) (g :: k) = ConstraintsFor f (FlipC (ComposeC c) g)++argDictV :: forall f c g v. (ArgDict f, ConstraintsForV f c g) => f v -> Dict (c (v g))+argDictV tag = case argDict tag of+  (Dict :: Dict (FlipC (ComposeC c) g a)) -> Dict++{-# DEPRECATED ArgDictV "Just use 'ArgDict'" #-}+type ArgDictV f = ArgDict f+ type Has (c :: k -> Constraint) f = (ArgDict f, ConstraintsFor f c) type Has' (c :: k -> Constraint) f (g :: k' -> k) = (ArgDict f, ConstraintsFor' f c g)-type HasV c f g = (ArgDictV f, ConstraintsForV f c g)+type HasV c f g = (ArgDict f, ConstraintsForV f c g)  has :: forall c f a r. (Has c f) => f a -> (c a => r) -> r has k r | (Dict :: Dict (c a)) <- argDict k = r

@@ -24,33 +24,16 @@         Right t -> AppT (VarT c) (AppT (VarT g) t)       l = length xs       constraints = foldl AppT (TupleT l) xs-      constraints' = foldl AppT (TupleT l) xs'   arity <- tyConArity n   tyVars <- replicateM (arity - 1) (newName "a")   let n' = foldr (\v x -> AppT x (VarT v)) (ConT n) tyVars   [d| instance ArgDict $(pure n') where         type ConstraintsFor  $(pure n') $(varT c) = $(pure constraints)-        type ConstraintsFor' $(pure n') $(varT c) $(varT g) = $(pure constraints')         argDict = $(LamCaseE <$> matches n 'argDict)-        argDict' = $(LamCaseE <$> matches n 'argDict')     |] -deriveArgDictV :: Name -> Q [Dec]-deriveArgDictV n = do-  vs <- gadtIndices n-  c <- newName "c"-  g <- newName "g"-  let xs = flip map vs $ \case-        Left t -> AppT (AppT (AppT (ConT ''ConstraintsForV) t) (VarT c)) (VarT g)-        Right v -> AppT (VarT c) $ AppT v (VarT g)-      l = length xs-      constraints = foldl AppT (TupleT l) xs-  ds <- deriveArgDict n-  d <- [d| instance ArgDictV $(pure $ ConT n) where-             type ConstraintsForV $(conT n) $(varT c) $(varT g) = $(pure constraints)-             argDictV = $(LamCaseE <$> matches n 'argDictV)-       |]-  return (d ++ ds)+{-# DEPRECATED deriveArgDictV "Just use 'deriveArgDict'" #-}+deriveArgDictV = deriveArgDict  matches :: Name -> Name -> Q [Match] matches n argDictName = do

@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE UndecidableSuperClasses #-}+#endif++module Data.Constraint.Flip+  ( FlipC+  ) where++import Data.Constraint++-- | Flip for constraints.+class c h g => FlipC (c :: k -> k' -> Constraint) (g :: k') (h :: k)+instance c h g => FlipC c g h