intrinsic-superclasses (empty) → 0.1.0.0

raw patch · 5 files changed

+109/−0 lines, 5 filesdep +basedep +containersdep +haskell-src-metasetup-changed

Dependencies added: base, containers, haskell-src-meta, mtl, template-haskell

Files

• LICENSE +0/−0
• README.md +7/−0
• Setup.hs +2/−0
• intrinsic-superclasses.cabal +34/−0
• src/Language/Haskell/TH/Instances.hs +66/−0

@@ -0,0 +1,7 @@+# intrinsic-superclasses++A template haskell implementation of the [Intrinsic Superclasses Proposal](https://ghc.haskell.org/trac/ghc/wiki/IntrinsicSuperclasses), which allows defining all typeclass methods at the "root" of the class heirarchy, rather than an instance declaration per class.++There are currently a number of limitations compared with the full language proposal (see: issues).++Functionality is added as-needed so drop an issue (and/or a pull request, if you're feeling ambitious 😉) if you have a use-case that isn't covered now.

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

@@ -0,0 +1,34 @@+name:                intrinsic-superclasses+version:             0.1.0.0+synopsis:           A quasiquoter implementation of the Intrinsic Superclasses Proposal+description:+  A template haskell implementation of the+  <https://ghc.haskell.org/trac/ghc/wiki/IntrinsicSuperclasses Intrinsic Superclasses Proposal>,+  which allows defining all superclass methods at the "root"+  of the class heirarchy in one declaration, rathar than+  an instance declaration per class+homepage:            https://github.com/daig/intrinsic-superclasses#readme+license:             MIT+license-file:        LICENSE+author:              Dai+maintainer:          dailectic@gmail.com+copyright:           Sodality+category:            Language+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  ghc-options:         -Wall+  exposed-modules:     Language.Haskell.TH.Instances+  build-depends:       base >= 4.7 && < 5+                      ,template-haskell+                      ,haskell-src-meta+                      ,containers+                      ,mtl+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/daig/intrinsic-superclasses

@@ -0,0 +1,66 @@+module Language.Haskell.TH.Instances (instances) where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax hiding (lift)+import Language.Haskell.Meta.Parse (parseDecs)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Data.Set (Set)+import qualified Data.Set as S+import Data.List (partition)+import Control.Monad.Writer (when,lift,execWriterT,Endo(..),MonadWriter(..))++-- | @QuasiQuoter@ for providing <https://ghc.haskell.org/trac/ghc/wiki/IntrinsicSuperclasses intrinsic-superclasses>.+--+-- Example:+--+-- >  class Semigroup a where mappend :: a -> a -> a+-- >  class Semigroup a => Monoid a where mempty :: a+-- >  class (Monoid a) => Group a where inverse :: a -> a+-- >  [instances| Num a => Group where+-- >      mempty = fromInteger 0+-- >      mappend a b = a + b+-- >      inverse = negate+-- >      |]+--+-- will generate the appropriate instances for @Semigroup@, @Monoid@, and @Group@:+--+-- >  instance Num a => Semigroup a where mappend a b = a + b+-- >  instance Num a => Monoid a where mempty = fromInteger 0+-- >  instance Num a => Group a where inverse = negate+instances :: QuasiQuoter+instances = QuasiQuoter+  {quoteExp = err "Exp"+  ,quotePat = err "Pat"+  ,quoteType = err "Type"+  ,quoteDec = \s -> case parseDecs ("instance " ++ s) of+    Left e -> error e+    Right d -> fmap concat $ mapM splitInstances d}+  where err s = const $ error $ "quasiquoter `instances` expected Dec, instead used as " ++ s+  ++splitInstances :: Dec -> DecsQ+splitInstances d = case d of+  InstanceD _overlaps ctx ty@(AppT _ instanceFor) instanceMethods ->+    let+      go methods t = case t of+        AppT (ConT className) _ -> do+          (superclasses,classMethods) <- lift $ reifyClass className +          let (theseMethods,methods') = partition (\x -> defOccName x `S.member` classMethods) methods+          when (length theseMethods > 0) $ tellCons $ InstanceD Nothing ctx (AppT (ConT className) instanceFor) theseMethods+          mapM_ (go methods') superclasses+        _ -> error $ "splitInstances: malformed instance head (" ++ show t ++ ")"+        {-_ -> pure ()-}+    in (`appEndo` []) <$> execWriterT (go instanceMethods ty)+  _ -> error $ "splitInstances: not an instance declaration " ++ show d+  where+    tellCons = tell . Endo . (:)+    defOccName x = case x of+      FunD (Name occ _) _ -> occ+      ValD (VarP (Name occ _)) _ _ -> occ+      _ -> error $ "defOccName: not a function or value definition " ++ show x+    reifyClass :: Name -> Q (Cxt,Set OccName)+    reifyClass n = do+      info <- reify n+      pure $ case info of+        ClassI (ClassD ctx _name  _tyvarbndr _fundeps methods) _instances -> (ctx,S.fromList [occ | SigD (Name occ _) _ <- methods])+        _ -> error "reifyClass: not a class name"