hset 0.0.3 → 0.1.0

raw patch · 6 files changed

+195/−33 lines, 6 filesdep +HUnitdep +hsetdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, hset

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−5
• hset.cabal +33/−2
• src/Data/HSet.hs +69/−24
• src/Data/HSet/Labeled.hs +9/−0
• src/Data/HSet/TypeLevel.hs +5/−2
• test/Main.hs +62/−0

@@ -1,11 +1,16 @@ # CHANGELOG -## 0.0.1-The first compilable and working version--## 0.0.2+## 0.1.0 ### Added-* Add `hask` to read from MonadReaer+* `Labeled`: newtype wrapper with anonymous type parameter of any+  kind. Usefull if you want just put several same-typed things to hset+* Instances of `Show`, `Eq`, `Ord` for `HSet`+* Tests added+### Updated+* TypeLevel is polykinded now+* base restricted up to >= 4.7+* HSet is strict now+* Docs improved  ## 0.0.3 ### Added@@ -13,3 +18,10 @@ * Export `hask` ### Updated * Make it compilable on base < 4.8++## 0.0.2+### Added+* Add `hask` to read from MonadReaer++## 0.0.1+The first compilable and working version

@@ -1,5 +1,5 @@ name:                hset-version:             0.0.3+version:             0.1.0 synopsis:            Primitive heterogenous read-only set license:             BSD3 license-file:        LICENSE@@ -18,11 +18,13 @@ library   default-language:    Haskell2010   hs-source-dirs:      src+  ghc-options: -Wall    exposed-modules:     Data.HSet+                     , Data.HSet.Labeled                      , Data.HSet.TypeLevel -  build-depends:       base >=4.6 && < 5+  build-depends:       base >=4.7 && < 5                      , mtl    default-extensions: CPP@@ -33,5 +35,34 @@                     , GADTs                     , KindSignatures                     , MultiParamTypeClasses+                    , PolyKinds+                    , RankNTypes+                    , ScopedTypeVariables                     , TypeFamilies                     , TypeOperators++test-suite test+  type:    exitcode-stdio-1.0+  default-language:    Haskell2010+  ghc-options:     -Wall+  hs-source-dirs:  test+  main-is: Main.hs++  default-extensions: CPP+                    , ConstraintKinds+                    , DataKinds+                    , FlexibleContexts+                    , FlexibleInstances+                    , GADTs+                    , KindSignatures+                    , MultiParamTypeClasses+                    , PolyKinds+                    , RankNTypes+                    , ScopedTypeVariables+                    , TypeFamilies+                    , TypeOperators++  build-depends: HUnit+               , base >=4.7 && < 5+               , hset+               , mtl

@@ -3,21 +3,66 @@        , HGet(..)        , Contains        , hask+         -- * Work with 'Labeled' elements+       , hgetLabeled+       , haskLabeled+         -- * Reexports+       , module Data.HSet.Labeled        ) where  import Control.Monad.Reader+import Data.HSet.Labeled import Data.HSet.TypeLevel+import Data.Typeable+ #if !(MIN_VERSION_base(4, 8, 0)) import Control.Applicative #endif --- | Heterogeneous set (list) of elements with unique types. Usefull--- with MonadReader+{- | Heterogeneous set (list) of elements with unique types. Usefull+with MonadReader.++>>> let x = HSCons (10 :: Int) $ HSCons (20 :: Double) HSNil+>>> x+HSCons (10) (HSCons (20.0) (HSNil))++>>> hget x :: Int+10++>>> hget x :: Double+20.0++Note how 'hget' just takes specific element from list of uniqly typed+elements depending on what type is required to be returned.++-}+ data HSet (elems :: [*]) where   HSNil  :: HSet '[]-  HSCons :: ('False ~ (Elem elem elems)) => elem -> HSet elems -> HSet (elem ': elems)+  HSCons :: ('False ~ (Elem elem elems)) => !elem -> !(HSet elems) -> HSet (elem ': elems)+  deriving ( Typeable ) +instance Show (HSet '[]) where+  show HSNil = "HSNil" +instance (Show e, Show (HSet els)) => Show (HSet (e ': els)) where+  show (HSCons e els) = "HSCons (" ++ show e ++ ") (" ++ show els ++ ")"++instance Eq (HSet '[]) where+  HSNil == HSNil = True++instance (Eq e, Eq (HSet els)) => Eq (HSet (e ': els)) where+  (HSCons e els) == (HSCons e' els') = (e == e') && (els == els')++instance Ord (HSet '[]) where+  HSNil `compare` HSNil = EQ++instance (Ord e, Ord (HSet els)) => Ord (HSet (e ': els)) where+  (HSCons e els) `compare` (HSCons e' els') = case e `compare` e' of+    EQ -> els `compare` els'+    x  -> x++-- | Typeclass for sets and elements. class (i ~ (Index e els)) => HGet els e i where   -- | Get any data from HSet for you   hget :: HSet els -> e@@ -28,6 +73,8 @@ instance (i ~ (Index e els), ('S i) ~ (Index e (e1 ': els)), HGet els e i) => HGet (e1 ': els) e ('S i) where   hget (HSCons _ els) = hget els +-- | Helper typefamily to derive that second argument contained in+-- list of first argument and we can perform 'hget' from set. type Contains els e = HGet els e (Index e els)  hask :: (MonadReader (HSet els) m, Contains els e) => m e@@ -35,30 +82,28 @@   h <- ask   return $ hget h --------------------------------------------------------------------- Tests: if this is compilable then tests done trollface.jpg --+{- | -fun :: HSet '[Int, Double, Integer, Float]-fun = HSCons 1-      $ HSCons 2-      $ HSCons 3-      $ HSCons 4-      $ HSNil+>>> let y = HSCons (Labeled 10 :: Labeled "x" Int) $ HSCons (Labeled 20 :: Labeled "y" Int) HSNil+>>> y+HSCons (Labeled {unLabeled = 10}) (HSCons (Labeled {unLabeled = 20}) (HSNil)) -funInt :: Int-funInt = hget fun+>>> hgetLabeled (Proxy :: Proxy "x") y :: Int+10 -funDoube :: Double-funDoube = hget fun+>>> hgetLabeled (Proxy :: Proxy "y") y :: Int+20 -funInteger :: Integer-funInteger = hget fun+-} -funFloat :: Float-funFloat = hget fun+hgetLabeled :: forall proxy label e els.+            (Contains els (Labeled label e))+            => proxy label -> HSet els -> e+hgetLabeled _ hset =+  let x = hget hset+  in unLabeled (x :: Labeled label e) -this :: (Double, Float)-this =-  let h = (,) <$> hask <*> hask-  in runReader h fun+haskLabeled :: forall proxy label e els m.+            (Contains els (Labeled label e), MonadReader (HSet els) m)+            => proxy label -> m e+haskLabeled p = hgetLabeled p <$> ask

@@ -0,0 +1,9 @@+module Data.HSet.Labeled where++import Data.Typeable++newtype Labeled (label :: k) (typ :: *) = Labeled { unLabeled :: typ }+    deriving ( Typeable, Show, Eq, Ord )++mkLabel :: proxy label -> e -> Labeled label e+mkLabel _ = Labeled

@@ -2,11 +2,14 @@  data Nat = Z | S Nat -type family Elem (typ :: *) (typs :: [*]) :: Bool where+-- | Calculates to 'True if first type argument contained in second+-- list element+type family Elem (typ :: k) (typs :: [k]) :: Bool where     Elem typ '[]             = 'False     Elem typ (typ ': typs)   = 'True     Elem typ1 (typ2 ': typs) = Elem typ1 typs -type family Index (typ :: *) (typs :: [*]) :: Nat where+-- | Calculates to Nat kinded type describing the index of first argument in second argument+type family Index (typ :: k) (typs :: [k]) :: Nat where   Index t (t ': ts) = 'Z   Index t (tt ': ts) = 'S (Index t ts)

@@ -0,0 +1,62 @@+module Main where++import Control.Monad+import Control.Monad.Reader+import Data.HSet+import Data.Proxy+import Test.HUnit++hset :: HSet '[Int, Double, Integer, Float]+hset = HSCons 1+      $ HSCons 2+      $ HSCons 3+      $ HSCons 4+      $ HSNil++hsetEq :: Bool+hsetEq = hset == hset++hsetCompare :: Ordering+hsetCompare = compare hset hset++hsetInt :: Int+hsetInt = hget hset++hsetDoube :: Double+hsetDoube = hget hset++hsetInteger :: Integer+hsetInteger = hget hset++hsetFloat :: Float+hsetFloat = hget hset++this :: (Double, Float)+this =+  let h = (,) <$> hask <*> hask+  in runReader h hset++data Label = This | That++labeledHSet :: HSet '[Labeled 'This Int, Labeled 'That Int, Labeled "hello" String]+labeledHSet = HSCons (Labeled 1)+              $ HSCons (Labeled 2)+              $ HSCons (Labeled "olleh")+              HSNil++main :: IO ()+main = void $ runTestTT $ TestList+    [ TestList+      [ TestCase $ hsetEq @?= True+      , TestCase $ hsetCompare @?= EQ+      , TestCase $ hsetInt @?= 1+      , TestCase $ hsetDoube @?= 2+      , TestCase $ hsetInteger @?= 3+      , TestCase $ hsetFloat @?= 4+      ]+    , TestList+      [ TestCase $ (hgetLabeled (Proxy :: Proxy 'This) labeledHSet) @?= (1 :: Int)+      , TestCase $ (hgetLabeled (Proxy :: Proxy 'That) labeledHSet) @?= (2 :: Int)+      , TestCase $ (hgetLabeled (Proxy :: Proxy "hello") labeledHSet) @?= "olleh"+      ]+    ]