classy-prelude-0.5.4/0000755000000000000000000000000012120570721012637 5ustar0000000000000000classy-prelude-0.5.4/ClassyPrelude.hs0000644000000000000000000001407212120570721015756 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude ( -- * CorePrelude module CorePrelude , Seq -- * Standard -- ** Monoid , empty , append , (++) -- ** Monad , module Control.Monad -- ** Mutable references , module Control.Concurrent.MVar.Lifted , module Data.IORef.Lifted -- * Non-standard -- ** List-like classes , map , concat , concatMap , filter , find , length , singleton , null , pack , unpack , repack , fromList , toList , mapM , mapM_ , forM , forM_ , replicateM , stripPrefix , isPrefixOf , stripSuffix , isSuffixOf , isInfixOf , break , span , dropWhile , takeWhile , any , all , splitAt, take, drop , fold , words , unwords , lines , unlines , split , reverse , readMay , replicate , intercalate , intersperse , encodeUtf8 , decodeUtf8 , subsequences , permutations , partition , zip, zip3, zip4, zip5, zip6, zip7 , unzip, unzip3, unzip4, unzip5, unzip6, unzip7 , zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zipWith7 , nub , nubBy , sort , sortBy , sortWith , group , groupBy , groupWith , cons , uncons , compareLength , Foldable.sum , Foldable.product , repeat -- ** Map-like , lookup , insert , delete -- ** Set-like , member , notMember , elem , notElem , union , difference , (\\) , intersection , intersect , unions -- ** Text-like , show , toLower , toUpper , toCaseFold , toStrict , fromStrict -- ** IO , readFile , writeFile , getLine , print -- ** Chunking , toChunks , fromChunks -- ** Force types -- | Helper functions for situations where type inferer gets confused. , asByteString , asLByteString , asHashMap , asHashSet , asText , asLText , asList , asMap , asMaybe , asSet , asVector ) where import qualified Prelude import Control.Monad (when, unless, void, liftM, ap, forever, join, sequence, sequence_) import Control.Concurrent.MVar.Lifted import Data.IORef.Lifted import Data.Monoid (Monoid) import qualified Data.Monoid as Monoid import Data.Foldable (Foldable) import qualified Data.Foldable as Foldable import CorePrelude hiding (print) import ClassyPrelude.Classes import ClassyPrelude.ByteString () import ClassyPrelude.Char () import ClassyPrelude.Classes () import ClassyPrelude.FilePath () import ClassyPrelude.HashMap () import ClassyPrelude.HashSet () import ClassyPrelude.LByteString () import ClassyPrelude.LText () import ClassyPrelude.List () import ClassyPrelude.Map () import ClassyPrelude.Maybe () import ClassyPrelude.Set () import ClassyPrelude.Text () import ClassyPrelude.Vector () import ClassyPrelude.Sequence (Seq) show :: (Show a, CanPack c Char) => a -> c show = pack . Prelude.show fromList :: CanPack c i => [i] -> c fromList = pack toList :: CanPack c i => c -> [i] toList = unpack readMay :: (Read b, CanPack a Char) => a -> Maybe b readMay a = case [x | (x, t) <- Prelude.reads (unpack a), null t] of [x] -> Just x _ -> Nothing -- | Repack from one type to another, dropping to a list in the middle. -- -- @repack = pack . unpack@. repack :: (CanPack a i, CanPack b i) => a -> b repack = pack . unpack append :: Monoid m => m -> m -> m append = mappend {-# INLINE append #-} empty :: Monoid m => m empty = mempty {-# INLINE empty #-} infixr 5 ++ (++) :: Monoid m => m -> m -> m (++) = mappend {-# INLINE (++) #-} infixl 9 \\{-This comment teaches CPP correct behaviour -} -- | An alias for `difference`. (\\) :: CanDifference c => c -> c -> c (\\) = difference {-# INLINE (\\) #-} -- | An alias for `intersection`. intersect :: CanIntersection c => c -> c -> c intersect = intersection {-# INLINE intersect #-} unions :: (Foldable cc, Monoid c, CanUnion c) => cc c -> c unions = Foldable.foldl' union Monoid.mempty intercalate :: (CanConcat c i, CanIntersperse c i) => i -> c -> i intercalate xs xss = concat (intersperse xs xss) asByteString :: ByteString -> ByteString asByteString = id asLByteString :: LByteString -> LByteString asLByteString = id asHashMap :: HashMap k v -> HashMap k v asHashMap = id asHashSet :: HashSet a -> HashSet a asHashSet = id asText :: Text -> Text asText = id asLText :: LText -> LText asLText = id asList :: [a] -> [a] asList = id asMap :: Map k v -> Map k v asMap = id asMaybe :: Maybe a -> Maybe a asMaybe = id asSet :: Set a -> Set a asSet = id asVector :: Vector a -> Vector a asVector = id forM :: CanMapM ci mco m i o => ci -> (i -> m o) -> mco forM = flip mapM forM_ :: (Monad m, CanMapM_ ci i) => ci -> (i -> m o) -> m () forM_ = flip mapM_ -- | An alias for 'member' elem :: CanMember c k => k -> c -> Bool elem = member -- | An alias for 'notMember' notElem :: CanMember c k => k -> c -> Bool notElem = notMember print :: (Show a, MonadIO m) => a -> m () print = liftIO . Prelude.print take :: CanSplitAt c i => i -> c -> c take i c = Prelude.fst (splitAt i c) drop :: CanSplitAt c i => i -> c -> c drop i c = Prelude.snd (splitAt i c) -- | Sort elements using the user supplied function to project something out of -- each element. -- Inspired by . sortWith :: (CanSortBy c a, Ord b) => (a -> b) -> c -> c sortWith f = sortBy $ comparing f -- | The 'groupWith' function uses the user supplied function which -- projects an element out of every list element in order to first sort the -- input list and then to form groups by equality on these projected elements -- -- Inspired by groupWith :: (CanGroupBy c a, Eq b) => (a -> b) -> c -> [c] groupWith f = groupBy (\a b -> f a == f b) classy-prelude-0.5.4/Setup.hs0000644000000000000000000000005612120570721014274 0ustar0000000000000000import Distribution.Simple main = defaultMain classy-prelude-0.5.4/LICENSE0000644000000000000000000000207512120570721013650 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. classy-prelude-0.5.4/classy-prelude.cabal0000644000000000000000000000443612120570721016566 0ustar0000000000000000name: classy-prelude version: 0.5.4 synopsis: A typeclass-based Prelude. description: Focuses on using common typeclasses when possible, and creating new ones to avoid name clashing. Exposes many recommended datastructures (Map, ByteString, etc) directly without requiring long import lists and qualified modules. homepage: https://github.com/snoyberg/classy-prelude license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@snoyman.com category: Control, Prelude build-type: Simple cabal-version: >=1.8 library exposed-modules: ClassyPrelude ClassyPrelude.Classes other-modules: ClassyPrelude.List ClassyPrelude.ByteString ClassyPrelude.LByteString ClassyPrelude.Text ClassyPrelude.LText ClassyPrelude.Map ClassyPrelude.Maybe ClassyPrelude.Set ClassyPrelude.FilePath ClassyPrelude.Vector ClassyPrelude.HashMap ClassyPrelude.HashSet ClassyPrelude.Char ClassyPrelude.Sequence build-depends: base >= 4 && < 5 , basic-prelude >= 0.3.4 && < 0.4 , system-filepath >= 0.4 && < 0.5 , transformers , containers >= 0.4.2 , text , bytestring , vector , unordered-containers , hashable , lifted-base >= 0.2 ghc-options: -Wall -fno-warn-orphans test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 build-depends: classy-prelude , base , hspec >= 1.3 , QuickCheck , transformers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/classy-prelude.git classy-prelude-0.5.4/test/0000755000000000000000000000000012120570721013616 5ustar0000000000000000classy-prelude-0.5.4/test/main.hs0000644000000000000000000004036412120570721015105 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Test.Hspec import Test.Hspec.QuickCheck import ClassyPrelude import ClassyPrelude.Classes import Test.QuickCheck.Arbitrary import Prelude (asTypeOf, undefined, fromIntegral) import qualified Prelude import Control.Monad.Trans.Writer (tell, Writer, runWriter) import Data.Maybe (isJust) import Data.Functor.Identity (runIdentity) dictionaryProps :: ( CanInsertVal a Int Char , CanDeleteVal a Int , Show a , Eq a , Arbitrary a , Monoid a , CanLookup a Int Char , CanPack a (Int, Char) ) => a -> Spec dictionaryProps dummy = do prop "insert x y (insert x z c) == insert x y c" $ \x y z c -> insert x y (insert x z (c `asTypeOf` dummy)) == insert x y c prop "insert x y (delete x c) == insert x y c" $ \x y c -> insert x y (delete x (c `asTypeOf` dummy)) == insert x y c prop "delete x (insert x y c) == delete x c" $ \x y c -> pack (unpack $ delete x (insert x y (c `asTypeOf` dummy))) == (pack (unpack ((delete x c) `asTypeOf` dummy) :: [(Int, Char)]) `asTypeOf` dummy) prop "lookup k (insert k v empty) == Just v" $ \k v -> lookup k (insert k v empty `asTypeOf` dummy) == Just v prop "lookup k (delete k c) == Nothing" $ \k c -> lookup k (delete k c`asTypeOf` dummy) == Nothing mapProps :: ( CanPack a i , CanPack b j , Eq a , Eq c , Show a , Arbitrary a , Eq b , Show b , Arbitrary b , CanMap a b i j , CanMap a c i k , CanMap b c j k ) => a -> (i -> j) -> (j -> k) -> Spec mapProps dummy f g = do prop "map f c == pack (map f (unpack c))" $ \c -> map f (c `asTypeOf` dummy) == pack (map f (unpack c)) prop "map (f . g) c == map f (map g c)" $ \c -> map (g . f) (c `asTypeOf` dummy) == map g (map f c) concatMapProps :: ( CanPack a i , CanPack b j , CanPack js j , Eq a , Show a , Arbitrary a , Eq b , Show b , Arbitrary b , CanMap a b i j , CanConcatMap a b i js ) => a -> (i -> js) -> Spec concatMapProps dummy f = do prop "concatMap f c == pack (concatMap (unpack . f) (unpack c))" $ \c -> concatMap f (c `asTypeOf` dummy) == pack (concatMap (unpack . f) (unpack c)) filterProps :: ( CanPack a i , Show a , Arbitrary a , Eq a , CanFilter a i ) => a -> (i -> Bool) -> Spec filterProps dummy f = do prop "filter f c == pack (filter f (unpack c))" $ \c -> (repack (filter f (c `asTypeOf` dummy)) `asTypeOf` dummy) == pack (filter f (unpack c)) filterMProps :: ( CanPack a i , Show a , Arbitrary a , Eq a , CanFilterM a i ) => a -> (i -> Bool) -> Spec filterMProps dummy f' = do prop "filterM f c == fmap pack (filterM f (unpack c))" $ \c -> runIdentity (fmap repack (filterM f (c `asTypeOf` dummy))) `asTypeOf` dummy == runIdentity (fmap pack (filterM f (unpack c))) where f = return . f' lengthProps :: ( Show a , Eq a , Arbitrary a , CanPack a i , CanLength a len , Prelude.Num len , Eq len , CanNull a , Ord len , Monoid a ) => a -> Spec lengthProps dummy = do prop "length c == fromIntegral (length (unpack c))" $ \c -> length (c `asTypeOf` dummy) == fromIntegral (length (unpack c)) prop "null c == (length c == 0)" $ \c -> null (c `asTypeOf` dummy) == (length c == 0) prop "length (x ++ y) <= length x + length y" $ \x y -> length (x ++ y `asTypeOf` dummy) <= length x + length y prop "length (x ++ y) >= max (length x) (length y)" $ \x y -> length (x ++ y `asTypeOf` dummy) >= max (length x) (length y) prop "length (x ++ empty) == length x" $ \x -> length (x ++ empty `asTypeOf` dummy) == length x prop "null empty" $ null (empty `asTypeOf` dummy) {- mapMProps :: ( Show a , Arbitrary a , CanPack a i , Eq i , CanMapM a co i i , CanPack co i , Eq co ) => a -> Spec -} mapMProps dummy = do let f :: Int -> Writer [Int] Int f x = tell [x] >> return x prop "mapM f c == mapM f (toList c)" $ \c -> runWriter (mapM f (c `asTypeOf` dummy)) == let (x, y) = runWriter (mapM f (toList c)) in (pack x, y) mapM_Props :: ( Show a , Arbitrary a , CanPack a i , Eq i , CanMapM_ a i ) => a -> Spec mapM_Props dummy = do let f x = tell [x] prop "mapM_ f c == mapM_ f (toList c)" $ \c -> runWriter (mapM_ f (c `asTypeOf` dummy)) == runWriter (mapM_ f (toList c)) foldProps dummy f accum = prop "fold f accum c == fold f accum (toList c)" $ \c -> fold f accum (c `asTypeOf` dummy) == fold f accum (toList c) replicateProps :: ( Show a , Eq a , CanReplicate a i len , Integral len , Show len , Arbitrary len , Show i , Arbitrary i ) => a -> ([i] -> a) -> Spec replicateProps dummy pack' = prop "replicate i a == pack (replicate i a)" $ \{- takes too long i-} a -> (replicate i a `asTypeOf` dummy) == pack' (replicate (fromIntegral i) a) where i = 3 chunkProps :: ( Eq a , Show a , Arbitrary a , CanToChunks a i , Monoid i ) => a -> Spec chunkProps dummy = do prop "fromChunks . toChunks == id" $ \a -> fromChunks (toChunks (a `asTypeOf` dummy)) == a prop "fromChunks . return . concat . toChunks == id" $ \a -> fromChunks [concat $ toChunks (a `asTypeOf` dummy)] == a stripSuffixProps :: ( Eq a , Monoid a , CanStripSuffix a , Show a , Arbitrary a ) => a -> Spec stripSuffixProps dummy = do prop "stripSuffix y (x ++ y) == Just x" $ \x y -> stripSuffix y (x ++ y) == Just (x `asTypeOf` dummy) prop "isJust (stripSuffix x y) == isSuffixOf x y" $ \x y -> isJust (stripSuffix x y) == isSuffixOf x (y `asTypeOf` dummy) replicateMProps :: ( Eq c , Show len , Arbitrary len , CanReplicateM c i len , CanReplicate c i len , Show i , Arbitrary i , Integral len ) => c -> Spec replicateMProps dummy = do prop "runIdentity (replicateM i (return x)) == replicate i x" $ \i' x -> let i = i' `mod` 20 in runIdentity (replicateM i (return x)) == (replicate i x `asTypeOf` dummy) utf8Props :: ( Eq t , Show t , Arbitrary t , CanEncodeUtf8 t b , CanDecodeUtf8 b t ) => t -> Spec utf8Props dummy = do prop "decodeUtf8 . encodeUtf8 == id" $ \t -> decodeUtf8 (encodeUtf8 t) == (t `asTypeOf` dummy) compareLengthProps :: ( Show c , Arbitrary c , CanCompareLength c , Show l , Arbitrary l , Integral l , CanLength c l ) => c -> Spec compareLengthProps dummy = do prop "compare (length c) i == compareLength c i" $ \i c -> compare (length c) i == compareLength (c `asTypeOf` dummy) i prefixProps :: ( Show c , Eq c , Monoid c , CanStripPrefix c , Arbitrary c ) => c -> Spec prefixProps dummy = do prop "x `isPrefixOf` (x ++ y)" $ \x y -> (x `asTypeOf` dummy) `isPrefixOf` (x ++ y) prop "stripPrefix x (x ++ y) == Just y" $ \x y -> stripPrefix x (x ++ y) == Just (y `asTypeOf` dummy) prop "stripPrefix x y == Nothing || x `isPrefixOf` y" $ \x y -> stripPrefix x y == Nothing || x `isPrefixOf` (y `asTypeOf` dummy) main :: IO () main = hspec $ do describe "dictionary" $ do describe "Data.Map" $ dictionaryProps (undefined :: Map Int Char) describe "Data.HashMap" $ dictionaryProps (undefined :: HashMap Int Char) describe "assoc list" $ dictionaryProps (undefined :: [(Int, Char)]) describe "map" $ do describe "list" $ mapProps (undefined :: [Int]) (+ 1) (+ 2) describe "Data.Vector" $ mapProps (undefined :: Vector Int) (+ 1) (+ 2) describe "Data.Set" $ mapProps (undefined :: Set Int) (+ 1) (+ 2) describe "Data.HashSet" $ mapProps (undefined :: HashSet Int) (+ 1) (+ 2) describe "Data.ByteString" $ mapProps (undefined :: ByteString) (+ 1) (+ 2) describe "Data.ByteString.Lazy" $ mapProps (undefined :: LByteString) (+ 1) (+ 2) describe "Data.Text" $ mapProps (undefined :: Text) succ succ describe "Data.Text.Lazy" $ mapProps (undefined :: LText) succ succ describe "Data.Sequence" $ mapProps (undefined :: Seq Int) succ succ describe "concatMap" $ do describe "list" $ concatMapProps (undefined :: [Int]) (\i -> [i + 1, i + 2]) describe "Data.Vector" $ concatMapProps (undefined :: Vector Int) (\i -> fromList [i + 1, i + 2]) describe "Data.ByteString" $ concatMapProps (undefined :: ByteString) (\i -> fromList [i + 1, i + 2]) describe "Data.ByteString.Lazy" $ concatMapProps (undefined :: LByteString) (\i -> fromList [i + 1, i + 2]) describe "Data.Text" $ concatMapProps (undefined :: Text) (\c -> pack [succ c, succ $ succ c]) describe "Data.Text.Lazy" $ concatMapProps (undefined :: LText) (\c -> pack [succ c, succ $ succ c]) describe "Data.Sequence" $ concatMapProps (undefined :: Seq Int) (\i -> pack [i + 1, i + 2]) describe "filter" $ do describe "list" $ filterProps (undefined :: [Int]) (< 20) describe "Data.Vector" $ filterProps (undefined :: Vector Int) (< 20) describe "Data.ByteString" $ filterProps (undefined :: ByteString) (< 20) describe "Data.ByteString.Lazy" $ filterProps (undefined :: LByteString) (< 20) describe "Data.Text" $ filterProps (undefined :: Text) (< 'A') describe "Data.Text.Lazy" $ filterProps (undefined :: LText) (< 'A') describe "Data.Map" $ filterProps (undefined :: Map Int Char) (\(i, _) -> i < 20) describe "Data.HashMap" $ filterProps (undefined :: HashMap Int Char) (\(i, _) -> i < 20) describe "Data.Set" $ filterProps (undefined :: Set Int) (< 20) describe "Data.Sequence" $ filterProps (undefined :: Seq Int) (< 20) describe "filterM" $ do describe "list" $ filterMProps (undefined :: [Int]) (< 20) describe "Data.Vector" $ filterMProps (undefined :: Vector Int) (< 20) describe "Data.Sequence" $ filterMProps (undefined :: Seq Int) (< 20) describe "length" $ do describe "list" $ lengthProps (undefined :: [Int]) describe "Data.Vector" $ lengthProps (undefined :: Vector Int) describe "Data.ByteString" $ lengthProps (undefined :: ByteString) describe "Data.ByteString.Lazy" $ lengthProps (undefined :: LByteString) describe "Data.Text" $ lengthProps (undefined :: Text) describe "Data.Text.Lazy" $ lengthProps (undefined :: LText) describe "Data.Map" $ lengthProps (undefined :: Map Int Char) describe "Data.HashMap" $ lengthProps (undefined :: HashMap Int Char) describe "Data.Set" $ lengthProps (undefined :: Set Int) describe "Data.HashSet" $ lengthProps (undefined :: HashSet Int) describe "Data.Sequence" $ lengthProps (undefined :: Seq Int) describe "mapM" $ do describe "list" $ mapMProps (undefined :: [Int]) describe "Data.Vector" $ mapMProps (undefined :: Vector Int) describe "Seq" $ mapMProps (undefined :: Seq Int) describe "mapM_" $ do describe "list" $ mapM_Props (undefined :: [Int]) describe "Data.Vector" $ mapM_Props (undefined :: Vector Int) describe "Set" $ mapM_Props (undefined :: Set Int) describe "HashSet" $ mapM_Props (undefined :: HashSet Int) describe "Seq" $ mapM_Props (undefined :: Seq Int) describe "fold" $ do let f = flip (:) describe "list" $ foldProps (undefined :: [Int]) f [] describe "Data.Vector" $ foldProps (undefined :: Vector Int) f [] describe "Data.ByteString" $ foldProps (undefined :: ByteString) f [] describe "Data.ByteString.Lazy" $ foldProps (undefined :: LByteString) f [] describe "Data.Text" $ foldProps (undefined :: Text) f [] describe "Data.Text.Lazy" $ foldProps (undefined :: LText) f [] describe "Data.Set" $ foldProps (undefined :: Set Int) f [] describe "Data.HashSet" $ foldProps (undefined :: HashSet Int) f [] describe "Data.Sequence" $ foldProps (undefined :: Seq Int) f [] describe "replicate" $ do describe "list" $ replicateProps (undefined :: [Int]) pack describe "Data.Vector" $ replicateProps (undefined :: Vector Int) pack describe "Data.ByteString" $ replicateProps (undefined :: ByteString) pack describe "Data.ByteString.Lazy" $ replicateProps (undefined :: LByteString) pack describe "Data.Text" $ replicateProps (undefined :: Text) concat describe "Data.Text.Lazy" $ replicateProps (undefined :: LText) concat describe "Data.Sequence" $ replicateProps (undefined :: Seq Int) pack describe "chunks" $ do describe "ByteString" $ chunkProps (asLByteString undefined) describe "Text" $ chunkProps (asLText undefined) describe "stripSuffix" $ do describe "Text" $ stripSuffixProps (undefined :: Text) describe "LText" $ stripSuffixProps (undefined :: LText) describe "ByteString" $ stripSuffixProps (undefined :: ByteString) describe "LByteString" $ stripSuffixProps (undefined :: LByteString) describe "Seq" $ stripSuffixProps (undefined :: Seq Int) describe "replicateM" $ do describe "list" $ replicateMProps (undefined :: [Int]) describe "Vector" $ replicateMProps (undefined :: Vector Int) describe "Seq" $ replicateMProps (undefined :: Seq Int) describe "encode/decode UTF8" $ do describe "Text" $ utf8Props (undefined :: Text) describe "LText" $ utf8Props (undefined :: LText) describe "compareLength" $ do describe "list" $ compareLengthProps (undefined :: [Int]) describe "Text" $ compareLengthProps (undefined :: Text) describe "LText" $ compareLengthProps (undefined :: LText) describe "Prefix" $ do describe "list" $ prefixProps (undefined :: [Int]) describe "Text" $ prefixProps (undefined :: Text) describe "LText" $ prefixProps (undefined :: LText) describe "ByteString" $ prefixProps (undefined :: ByteString) describe "LByteString" $ prefixProps (undefined :: LByteString) describe "Vector" $ prefixProps (undefined :: Vector Int) describe "Seq" $ prefixProps (undefined :: Seq Int) instance Arbitrary (Map Int Char) where arbitrary = fromList <$> arbitrary instance Arbitrary (HashMap Int Char) where arbitrary = fromList <$> arbitrary instance Arbitrary (Vector Int) where arbitrary = fromList <$> arbitrary instance Arbitrary (Set Int) where arbitrary = fromList <$> arbitrary instance Arbitrary (HashSet Int) where arbitrary = fromList <$> arbitrary instance Arbitrary ByteString where arbitrary = fromList <$> arbitrary instance Arbitrary LByteString where arbitrary = fromList <$> arbitrary instance Arbitrary Text where arbitrary = fromList <$> arbitrary instance Arbitrary LText where arbitrary = fromList <$> arbitrary instance Arbitrary (Seq Int) where arbitrary = fromList <$> arbitrary classy-prelude-0.5.4/ClassyPrelude/0000755000000000000000000000000012120570721015416 5ustar0000000000000000classy-prelude-0.5.4/ClassyPrelude/FilePath.hs0000644000000000000000000000131212120570721017443 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.FilePath () where import CorePrelude import ClassyPrelude.Classes import qualified Data.List as List import qualified Filesystem.Path.CurrentOS as FilePath instance CanPack FilePath Char where pack = FilePath.decodeString unpack = FilePath.encodeString instance CanIntersperse FilePath Char where intersperse c = pack . List.intersperse c . unpack instance CanStripPrefix FilePath where stripPrefix = FilePath.stripPrefix isPrefixOf a b = case stripPrefix a b of Nothing -> False Just {} -> True classy-prelude-0.5.4/ClassyPrelude/Maybe.hs0000644000000000000000000000265412120570721017016 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Maybe () where import CorePrelude import ClassyPrelude.Classes import qualified Data.Maybe as Maybe import qualified Control.Monad as Monad import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable instance CanMap (Maybe a) (Maybe b) a b where map = Monad.fmap instance CanConcatMap (Maybe a) (Maybe b) a (Maybe b) where concatMap = (Monad.=<<) instance CanFilter (Maybe a) a where filter = Monad.mfilter instance CanLength (Maybe a) Int where length a = if null a then 0 else 1 instance CanSingleton (Maybe a) a where singleton = Monad.return instance CanNull (Maybe a) where null = Maybe.isNothing instance CanPack (Maybe a) a where pack = Maybe.listToMaybe unpack = Maybe.maybeToList instance Monad m => CanMapM (Maybe i) (m (Maybe o)) m i o where mapM = Traversable.mapM instance CanMapM_ (Maybe a) a where mapM_ = Foldable.mapM_ instance Eq x => CanMember (Maybe x) x where member = Foldable.elem instance CanAny (Maybe a) a where any = Foldable.any all = Foldable.all instance CanFold (Maybe a) a accum where fold = Foldable.foldl' instance Eq a => CanIsInfixOf (Maybe a) where isInfixOf = (==) instance CanReverse (Maybe a) where reverse = id instance CanFind (Maybe a) a where find = Foldable.find classy-prelude-0.5.4/ClassyPrelude/LText.hs0000644000000000000000000000636612120570721017025 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.LText ( LText ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.IO as LText import qualified Data.Text.Lazy.Encoding as LText import qualified Data.Text.Encoding.Error as Text instance CanMap LText LText Char Char where map = LText.map instance CanConcatMap LText LText Char LText where concatMap = LText.concatMap instance CanFilter LText Char where filter = LText.filter instance CanSingleton LText Char where singleton = LText.singleton instance CanNull LText where null = LText.null instance CanPack LText Char where pack = LText.pack unpack = LText.unpack instance CanIntersperse LText Char where intersperse = LText.intersperse instance CanStripPrefix LText where stripPrefix = LText.stripPrefix isPrefixOf = LText.isPrefixOf instance CanBreak LText Char where break = LText.break span = LText.span dropWhile = LText.dropWhile takeWhile = LText.takeWhile instance CanAny LText Char where any = LText.any all = LText.all instance CanSplitAt LText Int64 where splitAt = LText.splitAt instance CanWords LText where words = LText.words unwords = LText.unwords instance CanLines LText where lines = LText.lines instance CanUnlines LText where unlines = LText.unlines instance CanSplit LText Char where split = LText.split instance CanStripSuffix LText where stripSuffix = LText.stripSuffix isSuffixOf = LText.isSuffixOf instance CanIsInfixOf LText where isInfixOf = LText.isInfixOf instance CanReverse LText where reverse = LText.reverse instance CanLength LText Int64 where length = LText.length instance CanFold LText Char accum where fold = LText.foldl' instance CanReplicate LText LText Int64 where replicate = LText.replicate instance CanToChunks LText Text where toChunks = LText.toChunks fromChunks = LText.fromChunks instance CanEncodeUtf8 LText LByteString where encodeUtf8 = LText.encodeUtf8 instance CanDecodeUtf8 LByteString LText where decodeUtf8 = LText.decodeUtf8With Text.lenientDecode instance CanToStrict LText Text where toStrict = LText.toStrict fromStrict = LText.fromStrict instance MonadIO m => CanGetLine (m LText) where getLine = liftIO LText.getLine instance CanToLower LText where toLower = LText.toLower instance CanToUpper LText where toUpper = LText.toUpper instance CanToCaseFold LText where toCaseFold = LText.toCaseFold instance CanFind LText Char where find = LText.find instance CanPartition LText Char where partition = LText.partition instance CanCons LText Char where cons = LText.cons instance CanUncons LText Char where uncons = LText.uncons instance CanCompareLength LText where compareLength c = LText.compareLength c . fromIntegral instance CanGroupBy LText Char where groupBy = LText.groupBy instance CanGroup LText Char where group = LText.group instance CanZipWith LText Char LText Char LText Char where zipWith = LText.zipWith instance CanZip LText Char LText Char [] where zip = LText.zip classy-prelude-0.5.4/ClassyPrelude/Set.hs0000644000000000000000000000311112120570721016501 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Set ( Set ) where import CorePrelude import ClassyPrelude.Classes import qualified Control.Monad as Monad import qualified Data.Foldable as Foldable import qualified Data.Set as Set instance (Ord a, Ord b) => CanMap (Set a) (Set b) a b where map = Set.map instance Ord a => CanFilter (Set a) a where filter = Set.filter instance CanLength (Set x) Int where length = Set.size instance CanSingleton (Set x) x where singleton = Set.singleton instance CanNull (Set x) where null = Set.null instance Ord x => CanPack (Set x) x where pack = Set.fromList unpack = Set.toList instance (Ord x, Set x ~ s, x ~ x') => CanInsert (x' -> s -> Set x) where insert = Set.insert instance Ord x => CanDeleteVal (Set x) x where deleteVal = Set.delete instance Ord x => CanMember (Set x) x where member = Set.member instance CanFold (Set a) a accum where fold = Set.foldl' instance Ord a => CanMapM_ (Set a) a where mapM_ f = Monad.mapM_ f . unpack instance CanFind (Set a) a where find = Foldable.find instance (Monoid m) => CanConcat (Set m) m where concat = Foldable.fold instance (Ord a) => CanPartition (Set a) a where partition = Set.partition instance (Ord a) => CanUnion (Set a) where union = Set.union instance (Ord a) => CanDifference (Set a) where difference = Set.difference instance (Ord a) => CanIntersection (Set a) where intersection = Set.intersection classy-prelude-0.5.4/ClassyPrelude/ByteString.hs0000644000000000000000000000604012120570721020044 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.ByteString ( ByteString ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.ByteString as ByteString import qualified Filesystem.Path.CurrentOS as FilePath instance CanMap ByteString ByteString Word8 Word8 where map = ByteString.map instance CanConcatMap ByteString ByteString Word8 ByteString where concatMap = ByteString.concatMap instance CanFilter ByteString Word8 where filter = ByteString.filter instance CanLength ByteString Int where length = ByteString.length instance CanSingleton ByteString Word8 where singleton = ByteString.singleton instance CanNull ByteString where null = ByteString.null instance CanPack ByteString Word8 where pack = ByteString.pack unpack = ByteString.unpack instance CanIntersperse ByteString Word8 where intersperse = ByteString.intersperse instance CanStripPrefix ByteString where stripPrefix x y | x `ByteString.isPrefixOf` y = Just $ ByteString.drop (ByteString.length x) y | otherwise = Nothing isPrefixOf = ByteString.isPrefixOf instance CanReadFile ByteString where readFile = liftIO . ByteString.readFile . FilePath.encodeString instance CanWriteFile ByteString where writeFile fp = liftIO . ByteString.writeFile (FilePath.encodeString fp) instance CanBreak ByteString Word8 where break = ByteString.break span = ByteString.span dropWhile = ByteString.dropWhile takeWhile = ByteString.takeWhile instance CanAny ByteString Word8 where any = ByteString.any all = ByteString.all instance CanSplitAt ByteString Int where splitAt = ByteString.splitAt instance CanReverse ByteString where reverse = ByteString.reverse instance CanFold ByteString Word8 accum where fold = ByteString.foldl' instance CanReplicate ByteString Word8 Int where replicate = ByteString.replicate instance CanStripSuffix ByteString where stripSuffix x y | x `ByteString.isSuffixOf` y = Just (ByteString.take (ByteString.length y - ByteString.length x) y) | otherwise = Nothing isSuffixOf = ByteString.isSuffixOf instance CanIsInfixOf ByteString where isInfixOf = ByteString.isInfixOf instance MonadIO m => CanGetLine (m ByteString) where getLine = liftIO ByteString.getLine instance CanPartition ByteString Word8 where partition = ByteString.partition instance CanCons ByteString Word8 where cons = ByteString.cons instance CanUncons ByteString Word8 where uncons = ByteString.uncons instance CanGroupBy ByteString Word8 where groupBy = ByteString.groupBy instance CanGroup ByteString Word8 where group = ByteString.group instance CanZipWith ByteString Word8 ByteString Word8 [a] a where zipWith = ByteString.zipWith instance CanZip ByteString Word8 ByteString Word8 [] where zip = ByteString.zip instance CanUnzip ByteString Word8 ByteString Word8 [] where unzip = ByteString.unzip classy-prelude-0.5.4/ClassyPrelude/Char.hs0000644000000000000000000000056612120570721016636 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Char where import CorePrelude import ClassyPrelude.Classes import qualified Data.Char as Char instance CanToLower Char where toLower = Char.toLower instance CanToUpper Char where toUpper = Char.toUpper classy-prelude-0.5.4/ClassyPrelude/LByteString.hs0000644000000000000000000000650612120570721020167 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.LByteString ( LByteString ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.ByteString as ByteString import qualified Filesystem.Path.CurrentOS as FilePath import qualified Data.ByteString.Lazy as LByteString instance CanMap LByteString LByteString Word8 Word8 where map = LByteString.map instance CanConcatMap LByteString LByteString Word8 LByteString where concatMap = LByteString.concatMap instance CanFilter LByteString Word8 where filter = LByteString.filter instance CanLength LByteString Int64 where length = LByteString.length instance CanSingleton LByteString Word8 where singleton = LByteString.singleton instance CanNull LByteString where null = LByteString.null instance CanPack LByteString Word8 where pack = LByteString.pack unpack = LByteString.unpack instance CanIntersperse LByteString Word8 where intersperse = LByteString.intersperse instance CanStripPrefix LByteString where stripPrefix x y | x `LByteString.isPrefixOf` y = Just $ LByteString.drop (LByteString.length x) y | otherwise = Nothing isPrefixOf = LByteString.isPrefixOf instance CanReadFile LByteString where readFile = liftIO . LByteString.readFile . FilePath.encodeString instance CanWriteFile LByteString where writeFile fp = liftIO . LByteString.writeFile (FilePath.encodeString fp) instance CanBreak LByteString Word8 where break = LByteString.break span = LByteString.span dropWhile = LByteString.dropWhile takeWhile = LByteString.takeWhile instance CanAny LByteString Word8 where any = LByteString.any all = LByteString.all instance CanSplitAt LByteString Int64 where splitAt = LByteString.splitAt instance CanReverse LByteString where reverse = LByteString.reverse instance CanFold LByteString Word8 accum where fold = LByteString.foldl' instance CanReplicate LByteString Word8 Int64 where replicate = LByteString.replicate instance CanToChunks LByteString ByteString where toChunks = LByteString.toChunks fromChunks = LByteString.fromChunks instance CanStripSuffix LByteString where stripSuffix x y | x `LByteString.isSuffixOf` y = Just (LByteString.take (LByteString.length y - LByteString.length x) y) | otherwise = Nothing isSuffixOf = LByteString.isSuffixOf instance CanToStrict LByteString ByteString where toStrict = ByteString.concat . toChunks fromStrict = fromChunks . return instance CanPartition LByteString Word8 where partition = LByteString.partition instance CanCons LByteString Word8 where cons = LByteString.cons instance CanUncons LByteString Word8 where uncons = LByteString.uncons instance CanGroupBy LByteString Word8 where groupBy = LByteString.groupBy instance CanGroup LByteString Word8 where group = LByteString.group instance CanRepeat LByteString Word8 where repeat = LByteString.repeat instance CanZipWith LByteString Word8 LByteString Word8 [a] a where zipWith = LByteString.zipWith instance CanZip LByteString Word8 LByteString Word8 [] where zip = LByteString.zip instance CanUnzip LByteString Word8 LByteString Word8 [] where unzip = LByteString.unzip classy-prelude-0.5.4/ClassyPrelude/Classes.hs0000644000000000000000000002070612120570721017354 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DefaultSignatures #-} module ClassyPrelude.Classes where import CorePrelude import qualified Data.List as List class CanMap ci co i o | ci -> i, co -> o, ci o -> co, co i -> ci where map :: (i -> o) -> ci -> co class CanConcatMap ci co i o | ci -> i, co -> o, ci o -> co, co i -> ci where concatMap :: (i -> o) -> ci -> co class CanFilter c i | c -> i where filter :: (i -> Bool) -> c -> c class CanFilterM c i | c -> i where filterM :: Monad m => (i -> m Bool) -> c -> m c class CanLength c len | c -> len where length :: c -> len class CanSingleton c i | c -> i where singleton :: i -> c class CanNull c where null :: c -> Bool class CanPack c i | c -> i where pack :: [i] -> c unpack :: c -> [i] subsequences :: c -> [c] subsequences = List.map pack . List.subsequences . unpack permutations :: c -> [c] permutations = List.map pack . List.permutations . unpack class CanIntersperse c i | c -> i where intersperse :: i -> c -> c class Monad m => CanMapM ci mco m i o | ci -> i, mco -> m o, ci o m -> mco, mco i -> ci where mapM :: (i -> m o) -> ci -> mco class CanMapM_ ci i | ci -> i where mapM_ :: Monad m => (i -> m o) -> ci -> m () class CanReplicateM c i len | c -> i len where replicateM :: Monad m => len -> m i -> m c class CanLookup c k v | c -> k v where lookup :: k -> c -> Maybe v class CanInsert f where insert :: f class CanInsertVal c k v | c -> k v where insertVal :: k -> v -> c -> c instance (CanInsertVal c' k v, c ~ c') => CanInsert (k -> v -> c -> c') where insert = insertVal class CanDelete f where delete :: f class CanDeleteVal c k | c -> k where deleteVal :: k -> c -> c instance (CanDeleteVal c' k, c ~ c') => CanDelete (k -> c -> c') where delete = deleteVal class CanMember c k | c -> k where member :: k -> c -> Bool notMember :: k -> c -> Bool notMember k = not . member k class CanReadFile a where readFile :: MonadIO m => FilePath -> m a class CanWriteFile a where writeFile :: MonadIO m => FilePath -> a -> m () class CanStripPrefix a where stripPrefix :: a -> a -> Maybe a isPrefixOf :: a -> a -> Bool class CanBreak c i | c -> i where break :: (i -> Bool) -> c -> (c, c) span :: (i -> Bool) -> c -> (c, c) dropWhile :: (i -> Bool) -> c -> c takeWhile :: (i -> Bool) -> c -> c class CanAny c i | c -> i where any :: (i -> Bool) -> c -> Bool all :: (i -> Bool) -> c -> Bool class CanSplitAt c i | c -> i where splitAt :: i -> c -> (c, c) class CanFold c i accum | c -> i where -- | Strict left fold. fold :: (accum -> i -> accum) -> accum -> c -> accum class CanWords t where words :: t -> [t] unwords :: [t] -> t class CanLines t where lines :: t -> [t] class CanUnlines t where unlines :: [t] -> t class CanSplit c i | c -> i where split :: (i -> Bool) -> c -> [c] class CanStripSuffix a where stripSuffix :: a -> a -> Maybe a isSuffixOf :: a -> a -> Bool class CanIsInfixOf a where isInfixOf :: a -> a -> Bool class CanReverse a where reverse :: a -> a class CanReplicate a i len | a -> i len where replicate :: len -> i -> a class CanToChunks c i | c -> i, i -> c where toChunks :: c -> [i] fromChunks :: [i] -> c class CanEncodeUtf8 ci co | co -> ci, ci -> co where encodeUtf8 :: ci -> co -- | Note: implementations should ensure that @decodeUtf8@ is a total -- function. As such, the standard @decodeUtf8@ provided by the text package -- should not be used, but instead @decodeUtf8With lenientDecode@. class CanDecodeUtf8 ci co | co -> ci, ci -> co where decodeUtf8 :: ci -> co class CanToStrict a b where toStrict :: a -> b fromStrict :: b -> a class CanGetLine a where getLine :: a class CanToLower a where toLower :: a -> a class CanToUpper a where toUpper :: a -> a class CanToCaseFold a where toCaseFold :: a -> a class CanFind c i | c -> i where find :: (i -> Bool) -> c -> Maybe i class CanConcat c i | c -> i where concat :: c -> i class CanPartition c i | c -> i where partition :: (i -> Bool) -> c -> (c, c) class CanNubBy c i | c -> i where nubBy :: (i -> i -> Bool) -> c -> c nub :: (Ord i, CanNubBy c i) => c -> c nub = nubBy (==) class CanUnion c where union :: c -> c -> c class CanDifference c where difference :: c -> c -> c class CanIntersection c where intersection :: c -> c -> c class CanSortBy c a | c -> a where sortBy :: (a -> a -> Ordering) -> c -> c class Ord a => CanSort c a | c -> a where sort :: c -> c default sort :: CanSortBy c a => c -> c sort = sortBy compare class CanCons c a where cons :: a -> c -> c class CanUncons c a where uncons :: c -> Maybe (a, c) class CanCompareLength c where -- | This is a more effective alternative to statements like @i >= length -- xs@ for types having an O(n) complexity of `length` operation like list -- or `Text`. It does not traverse the whole data structure if the value -- being compared to is lesser. compareLength :: (Integral l) => c -> l -> Ordering class CanGroupBy c a | c -> a where groupBy :: (a -> a -> Bool) -> c -> [c] class CanGroup c a | c -> a where group :: c -> [c] default group :: (CanGroupBy c a, Eq a) => c -> [c] group = groupBy (==) class CanRepeat c a | c -> a where repeat :: a -> c class CanZipWith c1 i1 c2 i2 c3 i3 | c1 -> i1, c2 -> i2, c3 -> i3 where zipWith :: (i1 -> i2 -> i3) -> c1 -> c2 -> c3 class CanZipWith3 c1 i1 c2 i2 c3 i3 c4 i4 | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4 where zipWith3 :: (i1 -> i2 -> i3 -> i4) -> c1 -> c2 -> c3 -> c4 class CanZipWith4 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5 where zipWith4 :: (i1 -> i2 -> i3 -> i4 -> i5) -> c1 -> c2 -> c3 -> c4 -> c5 class CanZipWith5 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6 where zipWith5 :: (i1 -> i2 -> i3 -> i4 -> i5 -> i6) -> c1 -> c2 -> c3 -> c4 -> c5 -> c6 class CanZipWith6 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 c7 i7 | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6, c7 -> i7 where zipWith6 :: (i1 -> i2 -> i3 -> i4 -> i5 -> i6 -> i7) -> c1 -> c2 -> c3 -> c4 -> c5 -> c6 -> c7 class CanZipWith7 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 c7 i7 c8 i8 | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6, c7 -> i7, c8 -> i8 where zipWith7 :: (i1 -> i2 -> i3 -> i4 -> i5 -> i6 -> i7 -> i8) -> c1 -> c2 -> c3 -> c4 -> c5 -> c6 -> c7 -> c8 class CanZip c1 i1 c2 i2 t | c1 -> i1, c2 -> i2 where zip :: c1 -> c2 -> t (i1, i2) class CanZip3 c1 i1 c2 i2 c3 i3 t | c1 -> i1, c2 -> i2, c3 -> i3 where zip3 :: c1 -> c2 -> c3 -> t (i1, i2, i3) class CanZip4 c1 i1 c2 i2 c3 i3 c4 i4 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4 where zip4 :: c1 -> c2 -> c3 -> c4 -> t (i1, i2, i3, i4) class CanZip5 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5 where zip5 :: c1 -> c2 -> c3 -> c4 -> c5 -> t (i1, i2, i3, i4, i5) class CanZip6 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6 where zip6 :: c1 -> c2 -> c3 -> c4 -> c5 -> c6 -> t (i1, i2, i3, i4, i5, i6) class CanZip7 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 c7 i7 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6, c7 -> i7 where zip7 :: c1 -> c2 -> c3 -> c4 -> c5 -> c6 -> c7 -> t (i1, i2, i3, i4, i5, i6, i7) class CanUnzip c1 i1 c2 i2 t | c1 -> i1, c2 -> i2 where unzip :: t (i1, i2) -> (c1, c2) class CanUnzip3 c1 i1 c2 i2 c3 i3 t | c1 -> i1, c2 -> i2, c3 -> i3 where unzip3 :: t (i1, i2, i3) -> (c1, c2, c3) class CanUnzip4 c1 i1 c2 i2 c3 i3 c4 i4 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4 where unzip4 :: t (i1, i2, i3, i4) -> (c1, c2, c3, c4) class CanUnzip5 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5 where unzip5 :: t (i1, i2, i3, i4, i5) -> (c1, c2, c3, c4, c5) class CanUnzip6 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6 where unzip6 :: t (i1, i2, i3, i4, i5, i6) -> (c1, c2, c3, c4, c5, c6) class CanUnzip7 c1 i1 c2 i2 c3 i3 c4 i4 c5 i5 c6 i6 c7 i7 t | c1 -> i1, c2 -> i2, c3 -> i3, c4 -> i4, c5 -> i5, c6 -> i6, c7 -> i7 where unzip7 :: t (i1, i2, i3, i4, i5, i6, i7) -> (c1, c2, c3, c4, c5, c6, c7) classy-prelude-0.5.4/ClassyPrelude/Vector.hs0000644000000000000000000001342612120570721017222 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Vector ( Vector ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Foldable as Foldable import qualified Data.Vector as Vector instance CanMap (Vector a) (Vector b) a b where map = Vector.map instance CanConcatMap (Vector a) (Vector b) a (Vector b) where concatMap = Vector.concatMap instance CanFilter (Vector a) a where filter = Vector.filter instance CanFilterM (Vector a) a where filterM = Vector.filterM instance CanLength (Vector a) Int where length = Vector.length instance CanSingleton (Vector a) a where singleton = Vector.singleton instance CanNull (Vector a) where null = Vector.null instance CanPack (Vector a) a where pack = Vector.fromList unpack = Vector.toList instance CanIntersperse (Vector a) a where -- | Implementation is a rip off from . intersperse _ xs | null xs = Vector.empty intersperse sep xs = Vector.cons (Vector.head xs) $ prependToAll sep $ Vector.unsafeTail xs where prependToAll _ xs | null xs = Vector.empty prependToAll sep xs = Vector.cons sep $ Vector.cons (Vector.head xs) $ prependToAll sep $ Vector.unsafeTail xs instance Eq a => CanStripPrefix (Vector a) where stripPrefix x y | x == y1 = Just y2 | otherwise = Nothing where (y1, y2) = Vector.splitAt (Vector.length x) y isPrefixOf x y = Vector.take (Vector.length x) y == x instance Monad m => CanMapM (Vector i) (m (Vector o)) m i o where mapM = Vector.mapM instance CanMapM_ (Vector a) a where mapM_ = Vector.mapM_ instance Eq x => CanMember (Vector x) x where member x = Vector.any (== x) instance CanBreak (Vector a) a where break = Vector.break span = Vector.span dropWhile = Vector.dropWhile takeWhile = Vector.takeWhile instance CanAny (Vector a) a where any = Vector.any all = Vector.all instance CanSplitAt (Vector a) Int where splitAt = Vector.splitAt instance CanFold (Vector a) a accum where fold = Vector.foldl' instance CanReverse (Vector a) where reverse = Vector.reverse instance CanReplicate (Vector a) a Int where replicate = Vector.replicate instance CanReplicateM (Vector a) a Int where replicateM = Vector.replicateM instance CanFind (Vector a) a where find = Vector.find instance (Monoid m) => CanConcat (Vector m) m where concat = Foldable.fold instance CanPartition (Vector a) a where partition = Vector.partition instance CanCons (Vector a) a where cons = Vector.cons instance CanUncons (Vector a) a where uncons v = if null v then Nothing else Just (Vector.unsafeHead v, Vector.unsafeTail v) instance CanGroupBy (Vector a) a where -- | Implementation is stolen from groupBy k xs = switchL [] (\h t -> let n = 1 + findIndexOrEnd (not . k h) t in Vector.unsafeTake n xs : groupBy k (Vector.unsafeDrop n xs)) xs instance Eq a => CanGroup (Vector a) a where -- | A special case of 'groupBy', which is about 40% faster than -- /groupBy (==)/. -- -- Implementation is stolen from group xs = switchL [] (\h _ -> let (ys, zs) = span (== h) xs in ys : group zs) xs -- Helper functions stolen from -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length -- of the string if no element is found, rather than Nothing. findIndexOrEnd p xs = Vector.foldr (\x k n -> if p x then n else k (succ n)) id xs 0 switchL n j x = if null x then n else j (Vector.unsafeHead x) (Vector.unsafeTail x) instance CanZipWith (Vector a) a (Vector b) b (Vector c) c where zipWith = Vector.zipWith instance CanZipWith3 (Vector a) a (Vector b) b (Vector c) c (Vector d) d where zipWith3 = Vector.zipWith3 instance CanZipWith4 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e where zipWith4 = Vector.zipWith4 instance CanZipWith5 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e (Vector f) f where zipWith5 = Vector.zipWith5 instance CanZipWith6 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e (Vector f) f (Vector g) g where zipWith6 = Vector.zipWith6 instance CanZip (Vector a) a (Vector b) b Vector where zip = Vector.zip instance CanZip3 (Vector a) a (Vector b) b (Vector c) c Vector where zip3 = Vector.zip3 instance CanZip4 (Vector a) a (Vector b) b (Vector c) c (Vector d) d Vector where zip4 = Vector.zip4 instance CanZip5 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e Vector where zip5 = Vector.zip5 instance CanZip6 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e (Vector f) f Vector where zip6 = Vector.zip6 instance CanUnzip (Vector a) a (Vector b) b Vector where unzip = Vector.unzip instance CanUnzip3 (Vector a) a (Vector b) b (Vector c) c Vector where unzip3 = Vector.unzip3 instance CanUnzip4 (Vector a) a (Vector b) b (Vector c) c (Vector d) d Vector where unzip4 = Vector.unzip4 instance CanUnzip5 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e Vector where unzip5 = Vector.unzip5 instance CanUnzip6 (Vector a) a (Vector b) b (Vector c) c (Vector d) d (Vector e) e (Vector f) f Vector where unzip6 = Vector.unzip6 classy-prelude-0.5.4/ClassyPrelude/Text.hs0000644000000000000000000000567112120570721016707 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Text ( Text ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.IO as Text instance CanMap Text Text Char Char where map = Text.map instance CanConcatMap Text Text Char Text where concatMap = Text.concatMap instance CanFilter Text Char where filter = Text.filter instance CanLength Text Int where length = Text.length instance CanSingleton Text Char where singleton = Text.singleton instance CanNull Text where null = Text.null instance CanPack Text Char where pack = Text.pack unpack = Text.unpack instance CanIntersperse Text Char where intersperse = Text.intersperse instance CanStripPrefix Text where stripPrefix = Text.stripPrefix isPrefixOf = Text.isPrefixOf instance CanBreak Text Char where break = Text.break span = Text.span dropWhile = Text.dropWhile takeWhile = Text.takeWhile instance CanAny Text Char where any = Text.any all = Text.all instance CanSplitAt Text Int where splitAt = Text.splitAt instance CanWords Text where words = Text.words unwords = Text.unwords instance CanLines Text where lines = Text.lines instance CanUnlines Text where unlines = Text.unlines instance CanSplit Text Char where split = Text.split instance CanStripSuffix Text where stripSuffix = Text.stripSuffix isSuffixOf = Text.isSuffixOf instance CanIsInfixOf Text where isInfixOf = Text.isInfixOf instance CanReverse Text where reverse = Text.reverse instance CanFold Text Char accum where fold = Text.foldl' instance CanReplicate Text Text Int where replicate = Text.replicate instance CanEncodeUtf8 Text ByteString where encodeUtf8 = Text.encodeUtf8 instance CanDecodeUtf8 ByteString Text where decodeUtf8 = Text.decodeUtf8With Text.lenientDecode instance MonadIO m => CanGetLine (m Text) where getLine = liftIO Text.getLine instance CanToLower Text where toLower = Text.toLower instance CanToUpper Text where toUpper = Text.toUpper instance CanToCaseFold Text where toCaseFold = Text.toCaseFold instance CanFind Text Char where find = Text.find instance CanPartition Text Char where partition = Text.partition instance CanCons Text Char where cons = Text.cons instance CanUncons Text Char where uncons = Text.uncons instance CanCompareLength Text where compareLength c = Text.compareLength c . fromIntegral instance CanGroupBy Text Char where groupBy = Text.groupBy instance CanGroup Text Char where group = Text.group instance CanZipWith Text Char Text Char Text Char where zipWith = Text.zipWith instance CanZip Text Char Text Char [] where zip = Text.zip classy-prelude-0.5.4/ClassyPrelude/HashSet.hs0000644000000000000000000000262712120570721017320 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.HashSet ( HashSet ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.HashSet as HashSet import qualified Control.Monad as Monad instance (Eq b, Hashable b) => CanMap (HashSet a) (HashSet b) a b where map = HashSet.map instance CanLength (HashSet x) Int where length = HashSet.size instance Hashable x => CanSingleton (HashSet x) x where singleton = HashSet.singleton instance CanNull (HashSet x) where null = HashSet.null instance (Hashable x, Eq x) => CanPack (HashSet x) x where pack = HashSet.fromList unpack = HashSet.toList instance (Eq x, Hashable x, HashSet x ~ s, x ~ x') => CanInsert (x' -> s -> HashSet x) where insert = HashSet.insert instance (Eq x, Hashable x) => CanMember (HashSet x) x where member = HashSet.member instance CanFold (HashSet a) a accum where fold = HashSet.foldl' instance (Eq a, Hashable a) => CanMapM_ (HashSet a) a where mapM_ f = Monad.mapM_ f . unpack instance (Eq a, Hashable a) => CanUnion (HashSet a) where union = HashSet.union instance (Eq a, Hashable a) => CanDifference (HashSet a) where difference = HashSet.difference instance (Eq a, Hashable a) => CanIntersection (HashSet a) where intersection = HashSet.intersection classy-prelude-0.5.4/ClassyPrelude/Sequence.hs0000644000000000000000000000771112120570721017530 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Sequence ( Seq ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Monoid as Monoid import qualified Control.Monad as Monad import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable import qualified Data.Sequence as Seq import Data.Sequence (Seq, (<|), (|>), ViewL(..), viewl, ViewR(..), viewr) instance CanMap (Seq a) (Seq b) a b where map = Monad.fmap instance CanConcatMap (Seq a) (Seq b) a (Seq b) where concatMap = (Monad.=<<) instance CanFilter (Seq a) a where filter = Seq.filter instance CanFilterM (Seq a) a where filterM p = Foldable.foldlM (\ xs x -> do res <- p x; return $ if res then xs |> x else xs) Seq.empty instance CanLength (Seq a) Int where length = Seq.length instance CanSingleton (Seq a) a where singleton = Seq.singleton instance CanNull (Seq a) where null = Seq.null instance CanPack (Seq a) a where pack = Seq.fromList unpack = Foldable.toList instance CanIntersperse (Seq a) a where intersperse sep xs = case viewl xs of EmptyL -> Seq.empty (h :< t) -> h <| prependToAll sep t where prependToAll sep xs = case viewl xs of EmptyL -> Seq.empty (h :< t) -> sep <| (h <| prependToAll sep t) instance Eq a => CanStripPrefix (Seq a) where stripPrefix x y | x == y1 = Just y2 | otherwise = Nothing where (y1, y2) = Seq.splitAt (Seq.length x) y isPrefixOf x y = Seq.take (Seq.length x) y == x instance Eq a => CanStripSuffix (Seq a) where stripSuffix x y | x == y2 = Just y1 | otherwise = Nothing where (y1, y2) = Seq.splitAt (Seq.length y - Seq.length x) y isSuffixOf x y = takeRR (Seq.length x) y == x where takeRR 0 _ = Seq.empty takeRR n xs = case viewr xs of EmptyR -> Seq.empty xs' :> x -> takeRR (n-1) xs' |> x instance Monad m => CanMapM (Seq i) (m (Seq o)) m i o where mapM = Traversable.mapM instance CanMapM_ (Seq a) a where mapM_ = Foldable.mapM_ instance Eq x => CanMember (Seq x) x where member x = any (== x) instance CanBreak (Seq a) a where break = Seq.breakl span = Seq.spanl dropWhile = Seq.dropWhileL takeWhile = Seq.takeWhileL instance CanAny (Seq a) a where any = Foldable.any all = Foldable.all instance CanSplitAt (Seq a) Int where splitAt = Seq.splitAt instance CanFold (Seq a) a accum where fold = Foldable.foldl' instance CanReverse (Seq a) where reverse = Seq.reverse instance CanReplicate (Seq a) a Int where replicate = Seq.replicate instance CanReplicateM (Seq a) a Int where replicateM = Seq.replicateM instance CanFind (Seq a) a where find p s = case Seq.breakl p s of (_, s') -> case Seq.viewl s' of a :< _ -> Just a _ -> Nothing instance (Monoid m) => CanConcat (Seq m) m where concat = Foldable.fold instance CanPartition (Seq a) a where partition = Seq.partition instance CanSortBy (Seq a) a where sortBy = Seq.sortBy instance Ord a => CanSort (Seq a) a where sort = Seq.sort instance CanCons (Seq a) a where cons = (<|) instance CanUncons (Seq a) a where uncons s = case Seq.viewl s of EmptyL -> Nothing a :< s' -> Just (a, s') instance CanZipWith (Seq a) a (Seq b) b (Seq c) c where zipWith = Seq.zipWith instance CanZipWith3 (Seq a) a (Seq b) b (Seq c) c (Seq d) d where zipWith3 = Seq.zipWith3 instance CanZipWith4 (Seq a) a (Seq b) b (Seq c) c (Seq d) d (Seq e) e where zipWith4 = Seq.zipWith4 instance CanZip (Seq a) a (Seq b) b Seq where zip = Seq.zip instance CanZip3 (Seq a) a (Seq b) b (Seq c) c Seq where zip3 = Seq.zip3 instance CanZip4 (Seq a) a (Seq b) b (Seq c) c (Seq d) d Seq where zip4 = Seq.zip4 classy-prelude-0.5.4/ClassyPrelude/List.hs0000644000000000000000000001223312120570721016666 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.List () where import CorePrelude import ClassyPrelude.Classes import qualified Data.List as List import qualified Control.Monad as Monad import qualified Data.Monoid as Monoid import qualified Data.Set as Set instance CanMap [a] [b] a b where map = List.map instance CanConcatMap [a] [b] a [b] where concatMap = List.concatMap instance CanFilter [a] a where filter = List.filter instance CanFilterM [a] a where filterM = Monad.filterM instance CanLength [a] Int where length = List.length instance CanSingleton [a] a where singleton = return instance CanNull [a] where null = List.null instance CanPack [a] a where pack = id unpack = id subsequences = List.subsequences permutations = List.permutations instance CanIntersperse [a] a where intersperse = List.intersperse instance Monad m => CanMapM [i] (m [o]) m i o where mapM = Monad.mapM instance CanMapM_ [a] a where mapM_ = Monad.mapM_ instance Eq k => CanLookup [(k, v)] k v where lookup = List.lookup instance Eq k => CanInsertVal [(k, v)] k v where insertVal k v c = (k, v) : delete k c instance Eq k => CanDeleteVal [(k, v)] k where deleteVal k = filter ((/= k) . fst) instance Eq x => CanMember [x] x where member x = List.any (== x) instance Eq a => CanStripPrefix [a] where stripPrefix = List.stripPrefix isPrefixOf = List.isPrefixOf instance CanBreak [a] a where break = List.break span = List.span dropWhile = List.dropWhile takeWhile = List.takeWhile instance CanAny [a] a where any = List.any all = List.all instance CanSplitAt [c] Int where splitAt = List.splitAt instance CanFold [a] a accum where fold = List.foldl' instance (c ~ Char) => CanWords [c] where words = List.words unwords = List.unwords instance (c ~ Char) => CanLines [c] where lines = List.lines instance (c ~ Char) => CanUnlines [c] where unlines = List.unlines instance Eq a => CanIsInfixOf [a] where isInfixOf = List.isInfixOf instance CanReverse [a] where reverse = List.reverse instance CanReplicate [i] i Int where replicate = List.replicate instance CanReplicateM [a] a Int where replicateM = Monad.replicateM instance CanFind [a] a where find = List.find instance (Monoid m) => CanConcat [m] m where concat = Monoid.mconcat instance CanPartition [a] a where partition = List.partition instance CanNubBy [a] a where nubBy = List.nubBy nub = go Set.empty where go _ [] = [] go set (x:xs) | x `Set.member` set = go set xs | otherwise = x : go (Set.insert x set) xs instance (Eq a) => CanUnion [a] where union = List.union instance (Eq a) => CanDifference [a] where difference = (List.\\) instance (Eq a) => CanIntersection [a] where intersection = List.intersect instance CanSortBy [a] a where sortBy = List.sortBy instance Ord a => CanSort [a] a where sort = List.sort instance CanCons [a] a where cons = (:) instance CanUncons [a] a where uncons (head:tail) = Just (head, tail) uncons _ = Nothing instance CanCompareLength [a] where compareLength [] 0 = EQ compareLength _ i | i <= 0 = GT compareLength [] _ = LT compareLength (_:t) i = compareLength t (i-1) instance CanGroupBy [a] a where groupBy = List.groupBy instance Eq a => CanGroup [a] a where group = List.group instance CanRepeat [a] a where repeat = List.repeat instance CanZipWith [a] a [b] b [c] c where zipWith = List.zipWith instance CanZipWith3 [a] a [b] b [c] c [d] d where zipWith3 = List.zipWith3 instance CanZipWith4 [a] a [b] b [c] c [d] d [e] e where zipWith4 = List.zipWith4 instance CanZipWith5 [a] a [b] b [c] c [d] d [e] e [f] f where zipWith5 = List.zipWith5 instance CanZipWith6 [a] a [b] b [c] c [d] d [e] e [f] f [g] g where zipWith6 = List.zipWith6 instance CanZipWith7 [a] a [b] b [c] c [d] d [e] e [f] f [g] g [h] h where zipWith7 = List.zipWith7 instance CanZip ([] a) a ([] b) b [] where zip = List.zip instance CanZip3 ([] a) a ([] b) b ([] c) c [] where zip3 = List.zip3 instance CanZip4 ([] a) a ([] b) b ([] c) c ([] d) d [] where zip4 = List.zip4 instance CanZip5 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e [] where zip5 = List.zip5 instance CanZip6 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e ([] f) f [] where zip6 = List.zip6 instance CanZip7 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e ([] f) f ([] g) g [] where zip7 = List.zip7 instance CanUnzip ([] a) a ([] b) b [] where unzip = List.unzip instance CanUnzip3 ([] a) a ([] b) b ([] c) c [] where unzip3 = List.unzip3 instance CanUnzip4 ([] a) a ([] b) b ([] c) c ([] d) d [] where unzip4 = List.unzip4 instance CanUnzip5 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e [] where unzip5 = List.unzip5 instance CanUnzip6 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e ([] f) f [] where unzip6 = List.unzip6 instance CanUnzip7 ([] a) a ([] b) b ([] c) c ([] d) d ([] e) e ([] f) f ([] g) g [] where unzip7 = List.unzip7 classy-prelude-0.5.4/ClassyPrelude/Map.hs0000644000000000000000000000267112120570721016475 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.Map ( Map ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Foldable as Foldable import qualified Data.Map as Map instance CanMap (Map k v1) (Map k v2) v1 v2 where map = Map.map instance Ord k => CanFilter (Map k v) (k, v) where filter = Map.filterWithKey . curry instance CanLength (Map k v) Int where length = Map.size instance (v' ~ v) => CanSingleton (v' -> Map k v) k where singleton = Map.singleton instance CanNull (Map k v) where null = Map.null instance Ord k => CanPack (Map k v) (k, v) where pack = Map.fromList unpack = Map.toList instance Ord k => CanLookup (Map k v) k v where lookup = Map.lookup instance Ord k => CanInsertVal (Map k v) k v where insertVal = Map.insert instance Ord k => CanDeleteVal (Map k v) k where deleteVal = Map.delete instance CanFind (Map k v) v where find = Foldable.find instance (Monoid v) => CanConcat (Map k v) v where concat = Foldable.fold instance Ord k => CanPartition (Map k v) v where partition = Map.partition instance (Ord k) => CanUnion (Map k a) where union = Map.union instance (Ord k) => CanDifference (Map k a) where difference = Map.difference instance (Ord k) => CanIntersection (Map k a) where intersection = Map.intersection classy-prelude-0.5.4/ClassyPrelude/HashMap.hs0000644000000000000000000000341012120570721017271 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude.HashMap ( HashMap ) where import CorePrelude import ClassyPrelude.Classes import qualified Data.Foldable as Foldable import qualified Data.HashMap.Strict as HashMap instance CanMap (HashMap k v1) (HashMap k v2) v1 v2 where map = HashMap.map instance Hashable k => CanFilter (HashMap k v) (k, v) where filter = HashMap.filterWithKey . curry instance CanLength (HashMap k v) Int where length = HashMap.size instance (Eq k, Hashable k, v' ~ v) => CanSingleton (v' -> HashMap k v) k where singleton = HashMap.singleton instance CanNull (HashMap k v) where null = HashMap.null instance (Eq k, Hashable k) => CanPack (HashMap k v) (k, v) where pack = HashMap.fromList unpack = HashMap.toList instance (Eq k, Hashable k) => CanLookup (HashMap k v) k v where lookup = HashMap.lookup instance (Eq k, Hashable k) => CanInsertVal (HashMap k v) k v where insertVal = HashMap.insert instance (Eq k, Hashable k) => CanDeleteVal (HashMap k v) k where deleteVal = HashMap.delete instance CanFind (HashMap k v) v where find = Foldable.find instance (Monoid v) => CanConcat (HashMap k v) v where concat = Foldable.fold instance Hashable k => CanPartition (HashMap k v) v where partition p m = (HashMap.filter p m, HashMap.filter (not . p) m) instance (Hashable k, Eq k) => CanUnion (HashMap k a) where union = HashMap.union instance (Hashable k, Eq k) => CanDifference (HashMap k a) where difference = HashMap.difference instance (Hashable k, Eq k) => CanIntersection (HashMap k a) where intersection = HashMap.intersection