packages feed

pringletons 0.1.0.0 → 0.3

raw patch · 3 files changed

+53/−7 lines, 3 filesdep +vinyl

Dependencies added: vinyl

Files

pringletons.cabal view
@@ -1,5 +1,5 @@ name:                pringletons-version:             0.1.0.0+version:             0.3 synopsis:            Classes and data structures complementing the singletons library description:         Please see README.md homepage:            https://github.com/andrewthad/pringletons@@ -25,6 +25,7 @@     , aeson     , text     , vector+    , vinyl     , unordered-containers     , template-haskell   default-language:    Haskell2010
src/Data/Singletons/Class.hs view
@@ -31,6 +31,8 @@   , SomeSingWith1'   , SomeSingWith2(..)   , SomeSingWith2'+  , SingWith1(..)+  , ClassySomeSing(..)   -- * Classes for Applied   -- $appliedClasses   , EqApplied1(..)@@ -40,6 +42,8 @@   -- * Functions   , showKind   , readMaybeKind+  , eqSome+  , compareSome   ) where  import Data.Hashable@@ -192,6 +196,9 @@ newtype Applied3 (f :: TyFun k (TyFun j (TyFun l * -> *) -> *) -> *) (a :: k) (b :: j) (c :: l) =   Applied3 { getApplied3 :: Apply (Apply (Apply f a) b) c } +data SingWith1 (kproxy :: KProxy k) (f :: k -> *) (a :: k) where+  SingWith1 :: Sing a -> f a -> SingWith1 'KProxy f a+ data SomeSingWith1 (kproxy :: KProxy k) (f :: k -> *) where   SomeSingWith1 :: Sing a -> f a -> SomeSingWith1 'KProxy f @@ -254,8 +261,15 @@   toJSON (SomeSingWith2 s1 s2 v) =      toJSON [toJSONKind s1, toJSONKind s2, toJSONSing2 s1 s2 v] -instance FromJSON (SomeSingWith2 kproxy1 kproxy2 f) where-  parseJSON = error "from json somesingwith2: write this"+instance (FromJSONKind kproxy1, FromJSONKind kproxy2, FromJSONSing2 f) => FromJSON (SomeSingWith2 kproxy1 kproxy2 f) where+  parseJSON (Aeson.Array xs) = case Vector.toList xs of+    [v1,v2,v] -> do+      SomeSing s1 <- parseJSONKind v1+      SomeSing s2 <- parseJSONKind v2+      a <- parseJSONSing2 s1 s2 v+      return (SomeSingWith2 s1 s2 a)+    _ -> fail "SomeSingWith2: expected Array of three elements"+  parseJSON _ = mempty  instance (HashableKind kproxy1, HashableSing1 f) => Hashable (SomeSingWith1 kproxy1 f) where   hashWithSalt i (SomeSingWith1 s v) = i@@ -269,4 +283,28 @@ readMaybeKind s = listToMaybe    $ mapMaybe (\(a,x) -> if null x then Just a else Nothing)    $ readsPrecKind 0 s++-- | Helper function to demote an equality check. It would be nice if+--   this could be added as an 'Eq' instance for 'SomeSing', but it+--   would required collapsing a lot of the modules in 'singletons'+--   to prevent cyclic imports. Or it could be provided as an orphan +--   instance.+eqSome :: SEq kproxy => SomeSing kproxy -> SomeSing kproxy -> Bool+eqSome (SomeSing a) (SomeSing b) = fromSing (a %:== b)++-- | Helper function to demote a comparison+compareSome :: SOrd kproxy => SomeSing kproxy -> SomeSing kproxy -> Ordering+compareSome (SomeSing a) (SomeSing b) = fromSing (sCompare a b)++-- | This is a wrapper for 'SomeSing' that provides common typeclass instances+--   for it. This can be helpful when you want to use @Data.Set@ with 'SomeSing'.+newtype ClassySomeSing kproxy = ClassySomeSing { getClassySomeSing :: SomeSing kproxy }++instance SEq kproxy => Eq (ClassySomeSing kproxy) where+  ClassySomeSing a == ClassySomeSing b = eqSome a b++instance SOrd kproxy => Ord (ClassySomeSing kproxy) where+  compare (ClassySomeSing a) (ClassySomeSing b) = compareSome a b++
src/Data/Singletons/Map.hs view
@@ -17,6 +17,7 @@ import Data.Aeson.Types (Parser) import Data.Text (Text) import Data.Hashable+import Data.Vinyl.Core (Rec(..))  data SingMap (kproxy :: KProxy j) (f :: j -> *) where     Tip :: SingMap kproxy f@@ -1383,10 +1384,6 @@     go z (x:xs) = z `seq` go (f z x) xs  --- Helper function to demote a comparison-compareSome :: SOrd kproxy => SomeSing kproxy -> SomeSing kproxy -> Ordering-compareSome (SomeSing a) (SomeSing b) = fromSing (sCompare a b)- ltSome :: SOrd kproxy => SomeSing kproxy -> SomeSing kproxy -> Bool ltSome (SomeSing a) (SomeSing b) = fromSing (a %:< b) @@ -1408,4 +1405,14 @@   case testEquality a b of     Nothing -> error "unifyOnEq: inconsistent SEq and SDecide instances"     Just Refl -> x++---------------------+-- Record Helpers+---------------------+fromRec :: (SOrd kproxy, SDecide kproxy) => Rec (SingWith1 kproxy f) rs -> SingMap kproxy f+fromRec r = insertRec r empty++insertRec :: (SOrd kproxy, SDecide kproxy) => Rec (SingWith1 kproxy f) rs -> SingMap kproxy f -> SingMap kproxy f+insertRec RNil m = m+insertRec (SingWith1 s v :& rs) m = insert s v (insertRec rs m)