meep (empty) → 0.1.0.0
raw patch · 9 files changed
+367/−0 lines, 9 filesdep +QuickCheckdep +basedep +doctestsetup-changed
Dependencies added: QuickCheck, base, doctest, hspec, hspec-expectations-lens, lens, semigroups
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
- meep.cabal +74/−0
- src/Data/Meep.hs +187/−0
- test/Data/MeepSpec.hs +58/−0
- test/Doctest.hs +5/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+0.1.0.0+=======++ * Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Matvey Aksenov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Matvey Aksenov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+meep+====+[](https://hackage.haskell.org/package/meep)+[](https://travis-ci.org/supki/meep)++A Map-like structure that contains up to one key-value pair
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ meep.cabal view
@@ -0,0 +1,74 @@+name: meep+version: 0.1.0.0+synopsis:+ A silly container+description:+ A @Map@-like structure that contains up to one key-value pair+license: BSD3+license-file: LICENSE+author: Matvey Aksenov+maintainer: matvey.aksenov@gmail.com+category: Data+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/supki/meep++source-repository this+ type: git+ location: https://github.com/supki/meep+ tag: 0.1.0.0++library+ default-language:+ Haskell2010+ build-depends:+ base >= 4.6 && < 5+ , lens >= 4 && < 5+ , semigroups >= 0.9 && < 1+ hs-source-dirs:+ src+ exposed-modules:+ Data.Meep++test-suite spec+ default-language:+ Haskell2010+ type:+ exitcode-stdio-1.0+ build-depends:+ base >= 4.6+ , hspec+ , hspec-expectations-lens >= 0.3+ , lens+ , QuickCheck+ , semigroups+ hs-source-dirs:+ src+ test+ main-is:+ Spec.hs+ other-modules:+ Data.MeepSpec+ cpp-options:+ -DTEST++test-suite doctest+ default-language:+ Haskell2010+ type:+ exitcode-stdio-1.0+ build-depends:+ base >= 4.6+ , doctest >= 0.9+ hs-source-dirs:+ test+ main-is:+ Doctest.hs+ cpp-options:+ -DTEST
+ src/Data/Meep.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- | A @Map@-like structure that contains up to one key-value pair+--+-- A 'Meep' is strict in the key.+--+-- @Meep k a@ is isomorphic to @Maybe (k, a)@ with 'maybeing' witnessing the isomorphism+module Data.Meep+#ifdef TEST+ ( Meep(..)+#else+ ( Meep+#endif+ , empty+ , singleton+ , size+ , null+ , fromMaybe+ , toMaybe+ , maybeing+ , keys+ , elems+ ) where++import Control.Applicative (pure)+import Control.Lens+import Data.Monoid (mempty)+import Data.Data (Data, Typeable)+import Data.Foldable (Foldable)+import Data.Semigroup (Semigroup(..))+import GHC.Generics (Generic)+import Prelude hiding (null, lookup)+#ifdef TEST+import Test.QuickCheck (Arbitrary(..))+#endif++{-# ANN module "HLint: ignore Use fromMaybe" #-}++-- | A Meep from key @k@ to value @a@+data Meep k a = Empty | Meep !k a+ deriving (Eq, Ord, Functor, Foldable, Traversable, Typeable, Data, Generic)++instance (Show k, Show a) => Show (Meep k a) where+ showsPrec p m = showParen (p > 10) (showString "fromMaybe " . shows (toMaybe m))++-- | 'Meep's intersection+instance (Eq k, Semigroup a) => Semigroup (Meep k a) where+ Empty <> _ = Empty+ _ <> Empty = Empty+ Meep k v <> Meep k' v' = bool Empty (Meep k (v <> v')) (k == k')++instance Eq k => Ixed (Meep k a) where+ ix = ixAt++instance Eq k => At (Meep k a) where+ at k f m = indexed f k mv <&> \r -> case r of+ Nothing -> maybe m (const (delete k m)) mv+ Just v -> insert k v m+ where+ mv = lookup k m++type instance Index (Meep k a) = k+type instance IxValue (Meep k a) = a++instance FunctorWithIndex k (Meep k) where+ imap _ Empty = Empty+ imap f (Meep k a) = Meep k (f k a)++instance FoldableWithIndex k (Meep k) where+ ifoldMap _ Empty = mempty+ ifoldMap f (Meep k a) = f k a++instance TraversableWithIndex k (Meep k) where+ itraverse _ Empty = pure Empty+ itraverse f (Meep k a) = fmap (Meep k) (f k a)++instance AsEmpty (Meep k a) where+ _Empty = prism' (const Empty) (\x -> case x of Empty -> Just (); _ -> Nothing)++#ifdef TEST+instance (Arbitrary k, Arbitrary a) => Arbitrary (Meep k a) where+ arbitrary = fmap fromMaybe arbitrary+#endif++-- | /O(1)/. An empty 'Meep'+empty :: Meep k a+empty = Empty++-- | /O(1)/. A 'Meep' with a single key-value pair+singleton :: k -> a -> Meep k a+singleton = Meep++-- | /O(1)/. The size of the 'Meep'+--+-- >>> size empty+-- 0+--+-- >>> size (singleton 4 "foo")+-- 1+size :: Num b => Meep k a -> b+size = bool 1 0 . null++-- | /O(1)/. The emptiness check for the 'Meep'+--+-- >>> null empty+-- True+--+-- >>> null (singleton 4 "foo")+-- False+null :: Meep k a -> Bool+null Empty = True+null (Meep _ _) = False++-- | /O(1)/. Build the 'Meep'+--+-- @+-- fromMaybe ≡ view (from maybeing)+-- @+fromMaybe :: Maybe (k, a) -> Meep k a+fromMaybe = maybe Empty (uncurry Meep)++-- | /O(1)/. Destroy the 'Meep'+--+-- @+-- toMaybe ≡ view maybeing+-- @+toMaybe :: Meep k a -> Maybe (k, a)+toMaybe Empty = Nothing+toMaybe (Meep k a) = Just (k, a)++-- | /O(1)/. A witness to+--+-- @+-- 'Meep' k v ≅ 'Maybe' (k, v)+-- @+--+-- >>> singleton 4 "foo" ^. maybeing+-- Just (4,"foo")+--+-- >>> Nothing ^. from maybeing+-- fromMaybe Nothing+maybeing :: Iso (Meep k v) (Meep k' v') (Maybe (k, v)) (Maybe (k', v'))+maybeing = iso toMaybe fromMaybe++-- | /O(1)/. Return all keys from the 'Meep'+--+-- >>> keys (singleton 4 "foo")+-- Just 4+--+-- >>> keys empty+-- Nothing+keys :: Meep k a -> Maybe k+keys Empty = Nothing+keys (Meep k _) = Just k++-- | /O(1)/. Return all values from the 'Meep'+--+-- >>> elems (singleton 4 "foo")+-- Just "foo"+--+-- >>> elems empty+-- Nothing+elems :: Meep k a -> Maybe a+elems Empty = Nothing+elems (Meep _ a) = Just a++insert :: Eq k => k -> a -> Meep k a -> Meep k a+insert k a Empty = Meep k a+insert k a x@(Meep k' _) = bool x (Meep k a) (k == k')++lookup :: Eq k => k -> Meep k a -> Maybe a+lookup _ Empty = Nothing+lookup k' (Meep k a) = bool Nothing (Just a) (k == k')++delete :: Eq k => k -> Meep k a -> Meep k a+delete _ Empty = Empty+delete k' x@(Meep k _) = bool x Empty (k == k')++bool :: a -> a -> Bool -> a+bool f t p = if p then t else f
+ test/Data/MeepSpec.hs view
@@ -0,0 +1,58 @@+module Data.MeepSpec+ ( spec+ ) where++import Control.Lens+import Control.Exception (evaluate)+import Control.Exception.Lens (_ErrorCall)+import Test.Hspec.Lens+import Test.Hspec.QuickCheck++import Data.Meep (Meep)+import qualified Data.Meep as Meep+++spec :: Spec+spec = do+ context "general facts" $+ it "is strict in keys" $+ evaluate (Meep.singleton (error "strict in keys!" :: Bool) 4) `shouldThrow`+ _ErrorCall.only "strict in keys!"++ context "lensy interface" $ do+ it "can insert into an empty Meep" $+ (Meep.empty & at 3 ?~ 'z') `shouldBe` Meep.singleton 3 'z'++ it "can update a non-empty Meep" $+ (Meep.singleton 3 'w' & at 3 ?~ 'z') `shouldBe` Meep.singleton 3 'z'++ it "won't update a non-empty Meep if keys do not match" $+ (Meep.singleton 3 'w' & at 8 ?~ 'z') `shouldBe` Meep.singleton 3 'w'++ it "can wipe a non-empty Meep" $+ (Meep.singleton 3 'w' & at 3 .~ Nothing) `shouldBe` Meep.empty++ it "can successfully lookup a key in a non-empty Meep" $+ (Meep.singleton 3 'w' ^? ix 3) `shouldBe` Just 'w'++ it "can unsuccessfully lookup a key in a non-empty Meep" $+ (Meep.singleton 3 'w' ^? ix 8) `shouldBe` Nothing++ it "can unsuccessfully lookup a key in an empty Meep" $+ (Meep.empty ^? ix 3) `shouldBe` (Nothing :: Maybe Char)++ it "can do lookups with the default value" $+ (Meep.singleton 3 'w' ^. at 4.non 't') `shouldBe` 't'++ it "can do successful member checks" $+ has (ix 3) (Meep.singleton 3 'w') `shouldBe` True++ it "can do unsuccessful member checks" $+ has (ix 8) (Meep.singleton 3 'w') `shouldBe` False++ describe "fromMaybe/toMaybe" $ do+ prop "toMaybe . fromMaybe is an identity" $ \x ->+ (Meep.toMaybe . Meep.fromMaybe) x == (x :: Maybe (Int, Char))++ prop "fromMaybe . toMaybe is an identity" $ \x ->+ (Meep.fromMaybe . Meep.toMaybe) x == (x :: Meep Int Char)
+ test/Doctest.hs view
@@ -0,0 +1,5 @@+import Test.DocTest+++main :: IO ()+main = doctest ["-isrc", "src/Data/Meep.hs"]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}