superconstraints (empty) → 0.0.1

raw patch · 5 files changed

+185/−0 lines, 5 filesdep +basedep +constraintsdep +containerssetup-changed

Dependencies added: base, constraints, containers, haskell-src-meta, mtl, tagged, template-haskell, type-eq

Files

LICENSE +30/−0
README.markdown +33/−0
Setup.hs +2/−0
src/Data/Constraint/Super.hs +73/−0
superconstraints.cabal +47/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (C) 2013 Ryan Trinkle++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ README.markdown view

@@ -0,0 +1,33 @@+## superconstraints++A way of inferring instance constraints given an instance.++Suppose you have a class like this:++```haskell+class C a++instance C a => C [a]+```++Normally, given `C [a]`, you cannot obtain `C a`; however, superconstraints allows you to add that capability:++```haskell+class HasSuper (C a) => C a++instance C a => C [a]+makeSuper "C [a]"+```++Then, you can retrieve the superconstraint by doing:++```haskell+case super (Proxy :: Proxy (C [a])) of+  Dict -> ...+```++The superconstraint dictionary will include all of the constraints required by the instance.++### Future Improvements++* Replace the crazy string argument to `makeSuper` with something more sensible

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Data/Constraint/Super.hs view

@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds, Rank2Types, TypeOperators, ScopedTypeVariables, GADTs, TemplateHaskell, LambdaCase #-}+module Data.Constraint.Super where++import Data.Proxy (Proxy)+import Data.Constraint (Constraint, Dict (Dict), (:-) (Sub))+import Control.Monad (filterM)+import Control.Applicative ((<$>))+import Data.Data (Data, gmapM)+import Type.Eq ((:~:) (Eq), dynamicEq)+import Data.Map (Map)+import qualified Data.Map as Map+import Control.Monad.State (StateT, evalStateT, get, put, lift)+import Language.Haskell.Meta.Parse (parseType)++import Language.Haskell.TH.Syntax hiding (lift)++class HasSuper c where+  type Super c :: Constraint+  instantiate :: HasSuper c :- c+  super :: Proxy c -> Dict (Super c)++normalizeInstanceHead :: Type -> Q Type+normalizeInstanceHead t = do+  let f :: forall d. Data d => d -> StateT (Integer, Map String Name) Q d+      f x = case dynamicEq :: Maybe (d :~: Name) of+        Just Eq ->+          let b = nameBase x+          in lift (qLookupName True b) >>= \case+            Just n' -> return n'+            Nothing -> do+              (nextId, m) <- get+              case Map.lookup b m of+                Just n' -> return n'+                Nothing -> do+                  let n' = mkName $ "a" ++ show nextId+                  put (succ nextId, Map.insert b n' m)+                  return n'+        _ -> case dynamicEq :: Maybe (d :~: Type) of+          Just Eq+            | ConT n' <- x+            , nameBase n' == "()"+            -> return $ TupleT 0+          _ -> gmapM f x+  evalStateT (gmapM f t) (1, Map.empty)++getClassName :: Type -> Maybe Name+getClassName = \case+  ConT n -> Just n+  AppT t _ -> getClassName t+  _ -> Nothing++-- | Note: this is not compatible with PolyKinds+makeSuper :: String -> Q [Dec]+makeSuper tStr = case parseType tStr of+  Left s -> fail $ "Error: Could not parse instance head: " ++ s+  Right t -> do+    t' <- normalizeInstanceHead t+    case getClassName t' of+      Nothing -> fail $ "Error: Instance head must be of the form \"ClassName (t1) (t2) (t3)...\""+      Just className -> do+        qReify className >>= \case+          ClassI _ instances -> do+            filterM (\(InstanceD _ _ t2 _) -> (==t') <$> normalizeInstanceHead t2) instances >>= \x -> case x of+              [InstanceD _ cxt t2 _] -> return+                [InstanceD Nothing cxt (AppT (ConT ''HasSuper) t2)+                  [ TySynInstD ''Super $ TySynEqn [t2] $ foldl AppT (TupleT $ length cxt) cxt+                  , FunD 'super [Clause [WildP] (NormalB (ConE 'Dict)) []]+                  , FunD 'instantiate [Clause [] (NormalB (AppE (ConE 'Sub) (ConE 'Dict))) []]+                  ]+                ]+              [] -> fail "Error: No matching instances found"+              _ -> fail "Error: Found multiple instances"+          _ -> fail $ "Error: " ++ show className ++ " is not a typeclass"

+ superconstraints.cabal view

@@ -0,0 +1,47 @@+name:          superconstraints+category:      Constraints+version:       0.0.1+license:       BSD3+license-file:  LICENSE+cabal-version: >= 1.10+author:        Ryan Trinkle+maintainer:    Ryan Trinkle <ryan.trinkle@gmail.com+stability:     experimental+homepage:      http://github.com/ryantrinkle/superconstraints+bug-reports:   http://github.com/ryantrinkle/superconstraints/issues+copyright:     Copyright (C) 2013 Ryan Trinkle+synopsis:      Access an instance's constraints+description:   Constraint manipulation+build-type:    Simple+extra-source-files: README.markdown++source-repository head+  type: git+  location: git://github.com/ryantrinkle/superconstraints.git++library+  hs-source-dirs: src+  default-language: Haskell2010+  other-extensions:+    TypeFamilies,+    ConstraintKinds,+    Rank2Types,+    TypeOperators,+    ScopedTypeVariables,+    GADTs,+    TemplateHaskell,+    LambdaCase+++  build-depends: base >= 4.9.1 && < 4.10+               , constraints >= 0.9.1 && < 0.10+               , template-haskell >= 2.11.1 && < 2.12+               , haskell-src-meta >= 0.7.0.1 && < 0.8+               , mtl >= 2.2.1 && < 2.3+               , containers >= 0.5.7.1 && < 0.6+               , type-eq >= 0.5 && < 0.6+               , tagged >= 0.8.5 && < 0.9+  exposed-modules:+    Data.Constraint.Super++  ghc-options: -Wall