packages feed

quantification 0.1.1 → 0.1.2

raw patch · 3 files changed

+66/−9 lines, 3 filesdep +ghc-prim

Dependencies added: ghc-prim

Files

quantification.cabal view
@@ -1,5 +1,5 @@ name:                quantification-version:             0.1.1+version:             0.1.2 synopsis:            Data types and typeclasses to deal with universally and existentially quantified types description:         Please see README.md homepage:            https://github.com/andrewthad/quantification#readme@@ -16,8 +16,10 @@   hs-source-dirs: src   exposed-modules:     Data.Exists+    Data.Monoid.Lifted   build-depends:        base >= 4.9 && < 5+    , ghc-prim >= 0.5 && < 0.6     , hashable >= 1.2 && < 1.3     , aeson >= 0.11 && < 1.2     , text >= 1.0 && < 2.0
src/Data/Exists.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE CPP #-}  {-# OPTIONS_GHC -Wall #-}@@ -28,9 +31,12 @@   , ReadForall(..)   , EnumForall(..)   , BoundedForall(..)+  , SemigroupForall(..)   , MonoidForall(..)   , HashableForall(..)   , PathPieceForall(..)+  , FromJSONForall(..)+  , ToJSONForall(..) #if MIN_VERSION_aeson(1,0,0)    , ToJSONKeyForall(..)   , FromJSONKeyForall(..)@@ -41,17 +47,22 @@     -- * Functions   , showsForall   , showForall+  , defaultEqForallPoly+  , defaultCompareForallPoly   ) where  import Data.Proxy (Proxy(..))-import Data.Type.Equality ((:~:)(Refl))+import Data.Type.Equality ((:~:)(Refl),TestEquality(..)) import Control.Applicative (Const(..)) import Data.Aeson (ToJSON(..),FromJSON(..)) import Data.Hashable (Hashable(..)) import Data.Text (Text)+import Data.Functor.Classes (Eq1(..)) import Data.Functor.Sum (Sum(..)) import Data.Functor.Product (Product(..)) import Data.Functor.Compose (Compose(..))+import GHC.Int (Int(..))+import GHC.Prim (dataToTag#) import qualified Data.Aeson.Types as Aeson import qualified Text.Read as R import qualified Web.PathPieces as PP@@ -85,9 +96,15 @@  class EqForall f => EqForallPoly f where   eqForallPoly :: f a -> f b -> Bool+  default eqForallPoly :: TestEquality f => f a -> f b -> Bool+  eqForallPoly = defaultEqForallPoly +-- the default method does not work if your data type is a newtype wrapper+-- over a function, but that should not really ever happen. class (OrdForall f, EqForallPoly f) => OrdForallPoly f where   compareForallPoly :: f a -> f b -> Ordering+  default compareForallPoly :: TestEquality f => f a -> f b -> Ordering+  compareForallPoly = defaultCompareForallPoly  class ShowForall f where   showsPrecForall :: Int -> f a -> ShowS@@ -136,9 +153,11 @@   fromPathPieceForall :: Text -> Maybe (Exists f)   toPathPieceForall :: f a -> Text -class MonoidForall f where+class SemigroupForall f where+  sappendForall :: f a -> f a -> f a++class SemigroupForall f => MonoidForall f where   memptyForall :: f a-  mappendForall :: f a -> f a -> f a  -------------------- -- Instances Below@@ -156,9 +175,11 @@ instance ReadForall Proxy where   readPrecForall = fmap Exists R.readPrec  +instance SemigroupForall Proxy where+  sappendForall _ _ = Proxy + instance MonoidForall Proxy where   memptyForall = Proxy-  mappendForall _ _ = Proxy   instance EqForall ((:~:) a) where   eqForall Refl Refl = True@@ -199,6 +220,9 @@ instance EqForallPoly f => Eq (Exists f) where   Exists a == Exists b = eqForallPoly a b +instance EqForallPoly2 f => Eq (Exists2 f) where+  Exists2 a == Exists2 b = eqForallPoly2 a b+ instance OrdForallPoly f => Ord (Exists f) where   compare (Exists a) (Exists b) = compareForallPoly a b @@ -250,11 +274,11 @@     (p >= 11)      (showString "Pair " . showsPrecForall 11 f . showChar ' ' . showsPrecForall 11 g) -instance (EqForall f) => EqForall (Compose f g) where-  eqForall (Compose x) (Compose y) = eqForall x y+instance (Eq1 f, EqForall g) => EqForall (Compose f g) where+  eqForall (Compose x) (Compose y) = liftEq eqForall x y -instance (EqForallPoly f) => EqForallPoly (Compose f g) where-  eqForallPoly (Compose x) (Compose y) = eqForallPoly x y+instance (Eq1 f, EqForallPoly g) => EqForallPoly (Compose f g) where+  eqForallPoly (Compose x) (Compose y) = liftEq eqForallPoly x y  instance (EqForall f, EqForall g) => EqForall (Sum f g) where   eqForall (InL f1) (InL f2) = eqForall f1 f2@@ -268,4 +292,17 @@   compareForall (InR _) (InL _) = GT   compareForall (InL _) (InR _) = LT +defaultCompareForallPoly :: (TestEquality f, OrdForall f) => f a -> f b -> Ordering+defaultCompareForallPoly a b = case testEquality a b of+  Nothing -> compare (getTagBox a) (getTagBox b)+  Just Refl -> compareForall a b++defaultEqForallPoly :: (TestEquality f, EqForall f) => f a -> f b -> Bool+defaultEqForallPoly x y = case testEquality x y of+  Nothing -> False+  Just Refl -> eqForall x y++getTagBox :: a -> Int+getTagBox !x = I# (dataToTag# x)+{-# INLINE getTagBox #-}
+ src/Data/Monoid/Lifted.hs view
@@ -0,0 +1,18 @@+module Data.Monoid.Lifted+  ( Semigroup1(..)+  ) where++import Data.Functor.Compose++class Semigroup1 f where+  sappend1 :: (a -> a -> a) -> f a -> f a -> f a++instance Semigroup1 Maybe where+  sappend1 _ Nothing Nothing = Nothing+  sappend1 _ a@(Just _) Nothing = a+  sappend1 _ Nothing a@(Just _) = a+  sappend1 f (Just a) (Just b) = Just (f a b)++instance (Semigroup1 f, Semigroup1 g) => Semigroup1 (Compose f g) where+  sappend1 f (Compose a) (Compose b) = Compose ((sappend1 (sappend1 f)) a b)+