dependent-sum-template 0.0.0.5 → 0.0.0.6

raw patch · 2 files changed

+167/−5 lines, 2 filesdep +dependent-sum-templatedep ~basedep ~dependent-sumnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: dependent-sum-template

Dependency ranges changed: base, dependent-sum

API changes (from Hackage documentation)

Files

• dependent-sum-template.cabal +13/−5
• test/test.hs +154/−0

@@ -1,12 +1,12 @@ name:                   dependent-sum-template-version:                0.0.0.5+version:                0.0.0.6 stability:              experimental -cabal-version:          >= 1.6+cabal-version:          >= 1.8 build-type:             Simple  author:                 James Cook <mokus@deepbondi.net>-maintainer:             James Cook <mokus@deepbondi.net>+maintainer:             Ryan Trinkle <ryan.trinkle@obsidian.systems> license:                PublicDomain homepage:               /dev/null @@ -16,13 +16,21 @@  source-repository head   type: git-  location: git://github.com/mokus0/dependent-sum-template.git+  location: https://github.com/mokus0/dependent-sum-template  Library   hs-source-dirs:       src   exposed-modules:      Data.GADT.Compare.TH                         Data.GADT.Show.TH   build-depends:        base >= 3 && <5,-                        dependent-sum >= 0.2 && < 0.4,+                        dependent-sum >= 0.2 && < 0.5,                         template-haskell,                         th-extras >= 0.0.0.2++test-suite test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: test.hs+  build-depends: base+               , dependent-sum+               , dependent-sum-template

@@ -0,0 +1,154 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+import Control.Monad+import Data.Dependent.Sum+import Data.Functor.Identity+import Data.GADT.Compare+import Data.GADT.Compare.TH+import Data.GADT.Show+import Data.GADT.Show.TH++data MySum :: * -> * where+  MySum_Int :: MySum Int+  MySum_String :: MySum String++deriving instance Show (MySum a)++deriveGShow ''MySum+deriveGEq ''MySum+deriveGCompare ''MySum++main :: IO ()+main = do+  guard $ show MySum_Int == gshow MySum_Int+  guard $ show MySum_String == gshow MySum_String+  guard $ (MySum_Int `geq` MySum_Int) == Just Refl+  guard $ (MySum_Int `gcompare` MySum_Int) == GEQ+  guard $ (MySum_String `geq` MySum_String) == Just Refl+  guard $ (MySum_String `gcompare` MySum_String) == GEQ+  guard $ (MySum_Int `gcompare` MySum_String) == GLT+  guard $ (MySum_String `gcompare` MySum_Int) == GGT+  return ()++--TODO: Figure out how to best use these test cases; just checking that they+-- compile is useful, but it's probably more useful to check some properties as+-- well++-- test cases: should be able to generate instances for these+-- (Bar requiring the existence of an instance for Foo)+data Foo a where+    I :: Foo Int+    D :: Foo Double+    A :: Foo a -> Foo b -> Foo (a -> b)++data Bar a where+    F :: Foo a -> Bar a+    S :: Bar String++data Baz a where+    L :: Qux a -> Int -> Baz [a]++data Qux a where+    FB :: Foo (a -> b) -> Bar b -> Qux (a -> (b, b))++deriveGEq ''Foo+deriveGEq ''Bar+deriveGEq ''Baz+deriveGEq ''Qux++deriveGCompare ''Foo+deriveGCompare ''Bar+deriveGCompare ''Baz+deriveGCompare ''Qux++instance Show (Foo a) where showsPrec = gshowsPrec+instance Show (Bar a) where showsPrec = gshowsPrec+instance Show (Baz a) where showsPrec = gshowsPrec+instance Show (Qux a) where showsPrec = gshowsPrec++deriveGShow ''Foo+deriveGShow ''Bar+deriveGShow ''Baz+deriveGShow ''Qux++data Squudge a where+    E :: Ord a => Foo a -> Squudge a++deriveGEq ''Squudge+deriveGCompare ''Squudge+deriveGShow ''Squudge+instance Show (Squudge a) where showsPrec = gshowsPrec++data Splort a where+    Splort :: Squudge a -> a -> Splort a++-- -- deriveGEq ''Splort+-- This one theoretically could work (instance explicitly given below), but I don't think+-- it's something I want to try to automagically support.  It would require actually+-- matching on sub-constructors, which could get pretty ugly, especially since it may+-- not even be the case that a finite number of matches would suffice.+instance GEq Splort where+    geq (Splort (E x1) x2) (Splort (E y1) y2) = do+        Refl <- geq x1 y1+        guard (x2 == y2)+        Just Refl++deriving instance Show a => Show (Splort a)++instance GCompare Splort where+    gcompare (Splort (E x1) x2) (Splort (E y1) y2) =+        runGComparing $ do+            Refl <- geq' x1 y1+            compare' x2 y2+            return GEQ++-- Also should work for empty types+data Empty a+deriveGEq ''Empty+deriveGCompare ''Empty++-- Also supports types with multiple parameters, by quoting empty instance declarations+-- ([t||] brackets won't work because they can only quote types of kind *).+data Spleeb a b where+    P :: a Double -> Qux b -> Spleeb a b+-- need a cleaner 'one-shot' way of defining these - the empty instances need to appear+-- in the same quotation because the GEq context of the GCompare class causes stage+-- restriction errors... seems like GHC shouldn't actually check things like that till+-- the final splice, but whatever.+do+    [geqInst, gcompareInst, gshowInst] <-+        [d|+            instance GEq a => GEq (Spleeb a)+            instance GCompare a => GCompare (Spleeb a)+            instance Show (a Double) => GShow (Spleeb a)+          |]++    concat <$> sequence+        [ deriveGEq      geqInst+        , deriveGCompare gcompareInst+        , deriveGShow    gshowInst+        ]++instance Show (a Double) => Show (Spleeb a b) where showsPrec = gshowsPrec++-- another option; start from the declaration and juggle that a bit+do+    decs <- [d|+        data Fnord a where Yarr :: Fnord Double; Grr :: Fnord (Int -> String)+     |]++    geqInst         <- deriveGEq      decs+    gcompareInst    <- deriveGCompare decs+    gshowInst       <- deriveGShow    decs++    return $ concat+        [ decs+        , geqInst+        , gcompareInst+        , gshowInst+        ]++instance Show (Fnord a) where showsPrec = gshowsPrec