dependent-sum-0.7.2.0/0000755000000000000000000000000007346545000012617 5ustar0000000000000000dependent-sum-0.7.2.0/ChangeLog.md0000755000000000000000000000406007346545000014773 0ustar0000000000000000# Revision history for dependent-sum ## 0.7.2.0 - 2022-12-22 * Update to some-1.0.4.* ## 0.7.1.1 - 2022-12-12 * Support constraints-extras 0.4 ## 0.7.1.0 - 2020-03-25 * Shift version bounds for `some` to 1.0.1.* versions. ## 0.7.0.0 - 2020-03-24 * Fix ChangeLog to include the breaking change in 0.6.2.1/0.6.2.2 and properly do *major* version bump to reflect the breaking change. ## 0.6.2.2 - 2020-03-23 * Update GitHub repository in cabal metadata. ## 0.6.2.1 - 2020-03-21 * (Breaking change) Removed modules `Data.GADT.Compare`, `Data.GADT.Show`, `Data.Some` and now re-export them from the `some` package. This forced some deprecations to be fully realized. * Update cabal meta-information (tested with GHC 8.8). ## 0.6.2.0 - 2019-08-04 * Revert change that increased strictness of Data.Some.Some in 0.6.1 ## 0.6.1.0 - 2019-08-04 * Add legacy `eqTagged` and `compareTagged` functions. Fix deprecated `OrdTag` synonym (it was missing the `Has' Eq` constraint). To upgrade from dependent-sum <0.6, you will likely need to add enable the `FlexibleContexts` language extension, and possible others. ## 0.6 - 2019-03-21 * Use constraints-extras ArgDict/Has' to define the instances of Eq, Ord, Read and Show for DSum. This obviates the need for the EqTag, OrdTag, ReadTag and ShowTag classes. ## 0.5.1.0 * Add `mkSome` and `mapSome` to `Data.Some`. * Add `GEq`, `GCompare`, `GShow,` and `GRead` instances for `Sum` and `Product` (Except `GRead (Product a b)`). * Deprecate `(:=)` for `(:~:)` from `Data.Type.Equality`. In GHC 7.8 and above, this is the same as `(:~:)`. But now we no longer support earlier GHCs, so there's no point of the alias. * Remove support for GHC 7.x. * The git repositories for dependent-sum and dependent-sum-template are now the same, though the Haskell packages remain separate. ## 0.5.0.0 * Make `Some` a `newtype` with associated pattern synonyms using `unsafeCoerce` to avoid the GADT performance overhead. This shouldn't affect users. * Deprecate the constructor name `This` in favor of `Some`. * Drop support for GHC older than 8.0. dependent-sum-0.7.2.0/Setup.lhs0000644000000000000000000000011607346545000014425 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain dependent-sum-0.7.2.0/dependent-sum.cabal0000644000000000000000000000403607346545000016356 0ustar0000000000000000name: dependent-sum version: 0.7.2.0 stability: provisional cabal-version: 1.22 build-type: Simple author: James Cook maintainer: Obsidian Systems, LLC license: PublicDomain homepage: https://github.com/obsidiansystems/dependent-sum category: Data, Dependent Types synopsis: Dependent sum type description: A dependent sum is a generalization of a particular way of thinking about the @Either@ type. @Either a b@ can be thought of as a 2-tuple @(tag, value)@, where the value of the tag determines the type of the value. In particular, either @tag = Left@ and @value :: a@ or @tag = Right@ and @value :: b@. . This package allows you to define your own dependent sum types by using your own \"tag\" types. tested-with: GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1, GHC == 9.4.3 extra-source-files: ChangeLog.md , examples/*.hs source-repository head type: git location: https://github.com/obsidiansystems/dependent-sum Library default-language: Haskell2010 hs-source-dirs: src exposed-modules: Data.Dependent.Sum reexported-modules: Data.GADT.Compare, Data.GADT.Show, Data.Some other-extensions: PatternSynonyms build-depends: base >= 4.9 && <5 , constraints-extras >= 0.2 && < 0.5 -- tight bounds, so re-exported API is versioned properly. build-depends: some >= 1.0.4 && < 1.0.5 if impl(ghc >= 7.2) ghc-options: -trust base dependent-sum-0.7.2.0/examples/0000755000000000000000000000000007346545000014435 5ustar0000000000000000dependent-sum-0.7.2.0/examples/FooGADT.hs0000755000000000000000000000422407346545000016161 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-} module FooGADT where import Data.Dependent.Sum import Data.Functor.Identity import Data.GADT.Show import Data.GADT.Compare import Data.Constraint.Extras import Data.Constraint.Extras.TH import Data.List (sort) data Foo a where Foo :: Foo Double Bar :: Foo Int Baz :: Foo String Qux :: Foo Double deriveArgDict ''Foo {- -- NB: The instance for ArgDict could be manually written as: instance ArgDict Foo where type ConstraintsFor Foo c = (c Double, c Int, c String) argDict x = case x of Foo -> Dict Bar -> Dict Baz -> Dict Qux -> Dict -} instance Eq (Foo a) where (==) = defaultEq instance GEq Foo where geq Foo Foo = Just Refl geq Bar Bar = Just Refl geq Baz Baz = Just Refl geq Qux Qux = Just Refl geq _ _ = Nothing instance GCompare Foo where gcompare Foo Foo = GEQ gcompare Foo _ = GLT gcompare _ Foo = GGT gcompare Bar Bar = GEQ gcompare Bar _ = GLT gcompare _ Bar = GGT gcompare Baz Baz = GEQ gcompare Baz _ = GLT gcompare _ Baz = GGT gcompare Qux Qux = GEQ instance Show (Foo a) where showsPrec _ Foo = showString "Foo" showsPrec _ Bar = showString "Bar" showsPrec _ Baz = showString "Baz" showsPrec _ Qux = showString "Qux" instance GShow Foo where gshowsPrec = showsPrec instance GRead Foo where greadsPrec _ str = case tag of "Foo" -> [(GReadResult (\k -> k Foo), rest)] "Bar" -> [(GReadResult (\k -> k Bar), rest)] "Baz" -> [(GReadResult (\k -> k Baz), rest)] "Qux" -> [(GReadResult (\k -> k Qux), rest)] _ -> [] where (tag, rest) = splitAt 3 str foo :: Double -> DSum Foo Identity foo x = Foo ==> x bar :: Int -> DSum Foo Identity bar x = Bar ==> x baz :: String -> DSum Foo Identity baz x = Baz ==> x qux :: Double -> DSum Foo Identity qux x = Qux ==> x xs, xs', xs'' :: [DSum Foo Identity] xs = [bar 100, foo pi, qux (exp 1), baz "hello world"] xs' = read (show xs) `asTypeOf` xs xs'' = sort xsdependent-sum-0.7.2.0/src/Data/Dependent/0000755000000000000000000000000007346545000016165 5ustar0000000000000000dependent-sum-0.7.2.0/src/Data/Dependent/Sum.hs0000644000000000000000000001273607346545000017276 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} module Data.Dependent.Sum where import Control.Applicative import Data.Constraint.Extras import Data.Type.Equality ((:~:) (..)) import Data.GADT.Show import Data.GADT.Compare import Data.Maybe (fromMaybe) import Text.Read -- | A basic dependent sum type where the first component is a tag -- that specifies the type of the second. For example, think of a GADT -- such as: -- -- > data Tag a where -- > AString :: Tag String -- > AnInt :: Tag Int -- > Rec :: Tag (DSum Tag Identity) -- -- Then we can write expressions where the RHS of @(':=>')@ has -- different types depending on the @Tag@ constructor used. Here are -- some expressions of type @DSum Tag 'Identity'@: -- -- > AString :=> Identity "hello!" -- > AnInt :=> Identity 42 -- -- Often, the @f@ we choose has an 'Applicative' instance, and we can -- use the helper function @('==>')@. The following expressions all -- have the type @Applicative f => DSum Tag f@: -- -- > AString ==> "hello!" -- > AnInt ==> 42 -- -- We can write functions that consume @DSum Tag f@ values by -- matching, such as: -- -- > toString :: DSum Tag Identity -> String -- > toString (AString :=> Identity str) = str -- > toString (AnInt :=> Identity int) = show int -- > toString (Rec :=> Identity sum) = toString sum -- -- The @(':=>')@ constructor and @('==>')@ helper are chosen to -- resemble the @(key => value)@ construction for dictionary entries -- in many dynamic languages. The @:=>@ and @==>@ operators have very -- low precedence and bind to the right, making repeated use of these -- operators behave as you'd expect: -- -- > -- Parses as: Rec ==> (AnInt ==> (3 + 4)) -- > -- Has type: Applicative f => DSum Tag f -- > Rec ==> AnInt ==> 3 + 4 -- -- The precedence of these operators is just above that of '$', so -- @foo bar $ AString ==> "eep"@ is equivalent to @foo bar (AString -- ==> "eep")@. -- -- To use the 'Eq', 'Ord', 'Read', and 'Show' instances for @'DSum' -- tag f@, you will need an 'ArgDict' instance for your tag type. Use -- 'Data.Constraint.Extras.TH.deriveArgDict' from the -- @constraints-extras@ package to generate this -- instance. data DSum tag f = forall a. !(tag a) :=> f a infixr 1 :=>, ==> -- | Convenience helper. Uses 'pure' to lift @a@ into @f a@. (==>) :: Applicative f => tag a -> a -> DSum tag f k ==> v = k :=> pure v instance forall tag f. (GShow tag, Has' Show tag f) => Show (DSum tag f) where showsPrec p (tag :=> value) = showParen (p >= 10) ( gshowsPrec 0 tag . showString " :=> " . has' @Show @f tag (showsPrec 1 value) ) instance forall tag f. (GRead tag, Has' Read tag f) => Read (DSum tag f) where readsPrec p = readParen (p > 1) $ \s -> concat [ getGReadResult withTag $ \tag -> [ (tag :=> val, rest'') | (val, rest'') <- has' @Read @f tag (readsPrec 1 rest') ] | (withTag, rest) <- greadsPrec p s , let (con, rest') = splitAt 5 rest , con == " :=> " ] instance forall tag f. (GEq tag, Has' Eq tag f) => Eq (DSum tag f) where (t1 :=> x1) == (t2 :=> x2) = fromMaybe False $ do Refl <- geq t1 t2 return $ has' @Eq @f t1 (x1 == x2) instance forall tag f. (GCompare tag, Has' Eq tag f, Has' Ord tag f) => Ord (DSum tag f) where compare (t1 :=> x1) (t2 :=> x2) = case gcompare t1 t2 of GLT -> LT GGT -> GT GEQ -> has' @Eq @f t1 $ has' @Ord @f t1 (x1 `compare` x2) {-# DEPRECATED ShowTag "Instead of 'ShowTag tag f', use '(GShow tag, Has' Show tag f)'" #-} type ShowTag tag f = (GShow tag, Has' Show tag f) showTaggedPrec :: forall tag f a. (GShow tag, Has' Show tag f) => tag a -> Int -> f a -> ShowS showTaggedPrec tag = has' @Show @f tag showsPrec {-# DEPRECATED ReadTag "Instead of 'ReadTag tag f', use '(GRead tag, Has' Read tag f)'" #-} type ReadTag tag f = (GRead tag, Has' Read tag f) readTaggedPrec :: forall tag f a. (GRead tag, Has' Read tag f) => tag a -> Int -> ReadS (f a) readTaggedPrec tag = has' @Read @f tag readsPrec {-# DEPRECATED EqTag "Instead of 'EqTag tag f', use '(GEq tag, Has' Eq tag f)'" #-} type EqTag tag f = (GEq tag, Has' Eq tag f) eqTaggedPrec :: forall tag f a. (GEq tag, Has' Eq tag f) => tag a -> tag a -> f a -> f a -> Bool eqTaggedPrec tag1 tag2 f1 f2 = case tag1 `geq` tag2 of Nothing -> False Just Refl -> has' @Eq @f tag1 $ f1 == f2 eqTagged :: forall tag f a. EqTag tag f => tag a -> tag a -> f a -> f a -> Bool eqTagged k _ x0 x1 = has' @Eq @f k (x0 == x1) {-# DEPRECATED OrdTag "Instead of 'OrdTag tag f', use '(GCompare tag, Has' Eq tag f, Has' Ord tag f)'" #-} type OrdTag tag f = (GCompare tag, Has' Eq tag f, Has' Ord tag f) compareTaggedPrec :: forall tag f a. (GCompare tag, Has' Eq tag f, Has' Ord tag f) => tag a -> tag a -> f a -> f a -> Ordering compareTaggedPrec tag1 tag2 f1 f2 = case tag1 `gcompare` tag2 of GLT -> LT GEQ -> has' @Eq @f tag1 $ has' @Ord @f tag1 $ f1 `compare` f2 GGT -> GT compareTagged :: forall tag f a. OrdTag tag f => tag a -> tag a -> f a -> f a -> Ordering compareTagged k _ x0 x1 = has' @Eq @f k $ has' @Ord @f k (compare x0 x1)