foundation 0.0.18 → 0.0.19

raw patch · 24 files changed

+138/−79 lines, 24 filesdep ~basedep ~basementPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, basement

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Foundation/Array/Bitmap.hs +2/−0
• Foundation/Check.hs +2/−1
• Foundation/Check/Arbitrary.hs +6/−5
• Foundation/Check/Main.hs +2/−1
• Foundation/Exception.hs +1/−1
• Foundation/Hashing/Hashable.hs +5/−4
• Foundation/Hashing/SipHash.hs +3/−2
• Foundation/Monad/Except.hs +5/−3
• Foundation/Monad/Exception.hs +3/−1
• Foundation/Monad/MonadIO.hs +3/−1
• Foundation/Monad/Reader.hs +5/−3
• Foundation/Monad/Transformer.hs +3/−1
• Foundation/Primitive.hs +0/−1
• Foundation/String/Builder.hs +11/−42
• Foundation/Timing.hs +8/−5
• LICENSE +1/−1
• benchs/Fake/ByteString.hs +3/−0
• benchs/Fake/Vector.hs +2/−0
• benchs/Main.hs +37/−0
• foundation.cabal +2/−2
• tests/Test/Data/List.hs +7/−5
• tests/Test/Foundation/Network/IPv6.hs +5/−0
• tests/Test/Foundation/String.hs +15/−0

@@ -1,3 +1,10 @@+## 0.0.19++* Add Block, UArray, String Builder+* Improve concat for Block andd UArray+* Add unicode case mapping+* Re-add compatibility with ghc 7.8+ ## 0.0.18  * Add missing lowlevel Block functionality

@@ -13,6 +13,7 @@ -- unnecessary churn. -- {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-} module Foundation.Array.Bitmap     ( Bitmap     , MutableBitmap@@ -46,6 +47,7 @@ import qualified Data.List  data Bitmap = Bitmap (CountOf Bool) (UArray Word32)+    deriving (Typeable)  data MutableBitmap st = MutableBitmap (CountOf Bool) (MUArray Word32 st) 

@@ -37,6 +37,7 @@     ) where  import           Basement.Imports+import           Basement.Cast (cast) import           Basement.IntegralConv import           Basement.Types.OffsetSize import           Foundation.Check.Gen@@ -80,7 +81,7 @@                                       | otherwise -> return (PropertySuccess, iter)         where           iterW64 :: Word64-          iterW64 = let (CountOf iter') = iter in integralCast (integralUpsize iter' :: Int64)+          iterW64 = let (CountOf iter') = iter in cast (integralUpsize iter' :: Int64)            -- TODO revisit to let through timeout and other exception like ctrl-c or thread killing.           toResult :: IO (PropertyResult, Bool)

@@ -14,6 +14,7 @@ import           Basement.Imports import           Foundation.Primitive import           Basement.Nat+import           Basement.Cast (cast) import           Basement.IntegralConv import           Basement.Bounded import           Basement.Types.OffsetSize@@ -81,11 +82,11 @@  instance Arbitrary String where     arbitrary = genWithParams $ \params ->-        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (integralCast i) arbitrary)+        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (cast i) arbitrary)  instance Arbitrary AsciiString where     arbitrary = genWithParams $ \params ->-        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (integralCast i) arbitrary)+        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (cast i) arbitrary)  instance Arbitrary Float where     arbitrary = arbitraryF32@@ -116,7 +117,7 @@  instance Arbitrary a => Arbitrary [a] where     arbitrary = genWithParams $ \params ->-        fromList <$> (genMax (genMaxSizeArray params) >>= \i -> replicateM (integralCast i) arbitrary)+        fromList <$> (genMax (genMaxSizeArray params) >>= \i -> replicateM (cast i) arbitrary) #if __GLASGOW_HASKELL__ >= 710 instance (Arbitrary a, KnownNat n, NatWithinBound Int n) => Arbitrary (ListN.ListN n a) where     arbitrary = ListN.replicateM arbitrary@@ -153,7 +154,7 @@ arbitraryWord64 = genWithRng getRandomWord64  arbitraryInt64 :: Gen Int64-arbitraryInt64 = integralCast <$> arbitraryWord64+arbitraryInt64 = cast <$> arbitraryWord64  arbitraryF64 :: Gen Double arbitraryF64 = genWithRng getRandomF64@@ -163,7 +164,7 @@  arbitraryUArrayOf :: (PrimType ty, Arbitrary ty) => Word -> Gen (UArray ty) arbitraryUArrayOf size = between (0, size) >>=-    \sz -> fromList <$> replicateM (integralCast sz) arbitrary+    \sz -> fromList <$> replicateM (cast sz) arbitrary  -- | Call one of the generator weighted frequency :: NonEmpty [(Word, Gen a)] -> Gen a

@@ -17,6 +17,7 @@  import           Basement.Imports import           Basement.IntegralConv+import           Basement.Cast (cast) import           Basement.Bounded import           Basement.Types.OffsetSize import qualified Basement.Terminal.ANSI as ANSI@@ -285,7 +286,7 @@     params <- getGenParams . config <$> get     maxTests <- numTests . config <$> get -    (res,nb) <- liftIO $ iterateProperty (CountOf $ integralDownsize (integralCast maxTests :: Int64)) params rngIt prop+    (res,nb) <- liftIO $ iterateProperty (CountOf $ integralDownsize (cast maxTests :: Int64)) params rngIt prop     case res of         PropertyFailed {} -> failed         PropertySuccess   -> passed

@@ -9,7 +9,7 @@ import Foundation.Monad.Exception  finally :: MonadBracket m => m a -> m b -> m a-finally f g = generalBracket (pure ()) (\() a -> g >> pure a) (\() _ -> g) (const f)+finally f g = generalBracket (return ()) (\() a -> g >> return a) (\() _ -> g) (const f)  try :: (MonadCatch m, Exception e) => m a -> m (Either e a) try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))

@@ -13,6 +13,7 @@     ) where  import           Basement.Imports+import           Basement.Cast (cast) import           Basement.Compat.Natural import           Basement.Types.Word128 import           Basement.Types.Word256@@ -58,13 +59,13 @@             let b = integralDownsize (w :: Natural) :: Word8              in loop (w `div` 256) (hashMix8 b acc) instance Hashable Int8 where-    hashMix w = hashMix8 (integralCast w)+    hashMix w = hashMix8 (cast w) instance Hashable Int16 where-    hashMix w = hashMix16 (integralCast w)+    hashMix w = hashMix16 (cast w) instance Hashable Int32 where-    hashMix w = hashMix32 (integralCast w)+    hashMix w = hashMix32 (cast w) instance Hashable Int64 where-    hashMix w = hashMix64 (integralCast w)+    hashMix w = hashMix64 (cast w) instance Hashable Integer where     hashMix i iacc         | i == 0    = hashMix8 0 iacc

@@ -21,6 +21,7 @@ import           Basement.Compat.Base import           Basement.Types.OffsetSize import           Basement.PrimType+import           Basement.Cast (cast) import           Basement.IntegralConv import           Foundation.Hashing.Hasher import qualified Basement.UArray as A@@ -175,7 +176,7 @@         SipIncremental7 acc -> process c ist (lenMask .|. acc)   where     lenMask = (wlen .&. 0xff) .<<. 56-    wlen = integralCast (integralUpsize len :: Int64) :: Word64+    wlen = cast (integralUpsize len :: Int64) :: Word64  -- | same as 'hash', except also specifies the number of sipround iterations for compression (C) and digest (D). mixBa :: PrimType a => Int -> UArray a -> Sip -> Sip@@ -202,7 +203,7 @@                         .|. to64 0  (primBaIndex ba (ofs + Offset 7))                 in loop8 (process c st v) SipIncremental0 (start + Offset 8) l8         loop8 !st !incr !ofs !l = loop1 st incr ofs l-        loop1 !st !incr !ofs !l = case l - 1 of +        loop1 !st !incr !ofs !l = case l - 1 of             Nothing -> Sip st incr (currentLen + totalLen)             Just l1 -> let (!st', !incr') = mix8Prim c (primBaIndex ba ofs) st incr                         in loop1 st' incr' (ofs + Offset 1) l1

@@ -1,9 +1,11 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.Except     ( ExceptT(..)     ) where  import Basement.Imports+import Basement.Compat.AMP import Foundation.Monad.Base import Foundation.Monad.Reader @@ -12,7 +14,7 @@ instance Functor m => Functor (ExceptT e m) where     fmap f = ExceptT . fmap (fmap f) . runExceptT -instance (Functor m, Monad m) => Applicative (ExceptT e m) where+instance AMPMonad m => Applicative (ExceptT e m) where     pure a = ExceptT $ pure (Right a)     ExceptT f <*> ExceptT v = ExceptT $ do         mf <- f@@ -24,11 +26,11 @@                     Left e -> pure (Left e)                     Right x -> pure (Right (k x)) -instance Monad m => MonadFailure (ExceptT e m) where+instance AMPMonad m => MonadFailure (ExceptT e m) where     type Failure (ExceptT e m) = e     mFail = ExceptT . pure . Left -instance Monad m => Monad (ExceptT e m) where+instance AMPMonad m => Monad (ExceptT e m) where     return a = ExceptT $ return (Right a)     m >>= k = ExceptT $ do         a <- runExceptT m

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.Exception     ( MonadThrow(..)     , MonadCatch(..)@@ -6,10 +7,11 @@     ) where  import           Basement.Compat.Base+import           Basement.Compat.AMP import qualified Control.Exception as E  -- | Monad that can throw exception-class Monad m => MonadThrow m where+class AMPMonad m => MonadThrow m where     -- | Throw immediatity an exception.     -- Only a 'MonadCatch' monad will be able to catch the exception using 'catch'     throw :: Exception e => e -> m a

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.MonadIO     ( MonadIO(..)     ) where@@ -7,9 +8,10 @@ import Control.Monad.IO.Class #else import Basement.Compat.Base+import Basement.Compat.AMP  -- | Monads in which 'IO' computations may be embedded.-class Monad m => MonadIO m where+class AMPMonad m => MonadIO m where     -- | Lift a computation from the 'IO' monad.     liftIO :: IO a -> m a 

@@ -3,6 +3,7 @@ -- -- This is useful to keep a non-modifiable value -- in a context+{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.Reader     ( -- * MonadReader       MonadReader(..)@@ -12,10 +13,11 @@     ) where  import Basement.Compat.Base (($), (.), const)+import Basement.Compat.AMP import Foundation.Monad.Base import Foundation.Monad.Exception -class Monad m => MonadReader m where+class AMPMonad m => MonadReader m where     type ReaderContext m     ask :: m (ReaderContext m) @@ -32,7 +34,7 @@     fab <*> fa = ReaderT $ \r -> runReaderT fab r <*> runReaderT fa r     {-# INLINE (<*>) #-} -instance Monad m => Monad (ReaderT r m) where+instance AMPMonad m => Monad (ReaderT r m) where     return a = ReaderT $ const (return a)     {-# INLINE return #-}     ma >>= mab = ReaderT $ \r -> runReaderT ma r >>= \a -> runReaderT (mab a) r@@ -64,6 +66,6 @@                               (\a exn -> runReaderT (cleanupExcept a exn) c)                               (\a -> runReaderT (innerAction a) c) -instance Monad m => MonadReader (ReaderT r m) where+instance AMPMonad m => MonadReader (ReaderT r m) where     type ReaderContext (ReaderT r m) = r     ask = ReaderT return

@@ -1,10 +1,12 @@+{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.Transformer     ( MonadTrans(..)     ) where  import Basement.Compat.Base+import Basement.Compat.AMP  -- | Basic Transformer class class MonadTrans trans where     -- | Lift a computation from an inner monad to the current transformer monad-    lift :: Monad m => m a -> trans m a+    lift :: AMPMonad m => m a -> trans m a

@@ -19,7 +19,6 @@     -- * Integral convertion     , IntegralUpsize(..)     , IntegralDownsize(..)-    , IntegralCast(..)      -- * Evaluation     , NormalForm(..)

@@ -5,51 +5,20 @@ -- -- String Builder ----- This is extremely bad implementation of a builder implementation--- but provide a very similar API to the future fast implementation;--- So, in the spirit of getting started and to be able to start using--- the API, we don't wait for the fast implementation. module Foundation.String.Builder-    ( Builder-    , emit-    , emitChar+    ( module Basement.String.Builder     , toString     ) where -import           Basement.Compat.Base-import           Basement.Compat.Semigroup-import           Basement.String                (String)-import qualified Basement.String as S--data Builder = E String | T [Builder]--instance IsString Builder where-    fromString = E . fromString--instance Semigroup Builder where-    (<>) = append-instance Monoid Builder where-    mempty = empty-    mappend = append-    mconcat = concat--empty :: Builder-empty = T []--emit :: String -> Builder-emit s = E s--emitChar :: Char -> Builder-emitChar c = E (S.singleton c)+import Basement.String.Builder+import Basement.String (String)+import GHC.ST +-- | run the builder and return a `String`+--+-- alias to `runUnsafe`+--+-- This function is not safe, prefer `run`.+-- toString :: Builder -> String-toString = mconcat . flatten-  where-    flatten (E s) = [s]-    flatten (T l) = mconcat $ fmap flatten l--append :: Builder -> Builder -> Builder-append a b = T [a,b]--concat :: [Builder] -> Builder-concat = T+toString builder = runST (runUnsafe builder)

@@ -13,8 +13,11 @@     , measure     ) where -import           Basement.Imports-import           Basement.IntegralConv+import           Basement.Imports hiding (from)+import           Basement.From (from)+#if __GLASGOW_HASKELL__ < 802+import           Basement.Cast (cast)+#endif import           Basement.Monad -- import           Basement.UArray hiding (unsafeFreeze) import           Basement.UArray.Mutable (MUArray)@@ -57,7 +60,7 @@     if r then pure Nothing else Just <$> GHC.getGCStats  diffGC :: Maybe GHC.GCStats -> Maybe GHC.GCStats -> Maybe Word64-diffGC gc2 gc1 = integralCast <$> (((-) `on` GHC.bytesAllocated) <$> gc2 <*> gc1)+diffGC gc2 gc1 = cast <$> (((-) `on` GHC.bytesAllocated) <$> gc2 <*> gc1) #endif  -- | Simple one-time measurement of time & other metrics spent in a function@@ -72,7 +75,7 @@ -- | In depth timing & other metrics analysis of a function measure :: Word -> (a -> b) -> a -> IO Measure measure nbIters f a = do-    d <- mutNew (integralCast nbIters) :: IO (MUArray NanoSeconds (PrimState IO))+    d <- mutNew (from nbIters) :: IO (MUArray NanoSeconds (PrimState IO))     loop d 0     Measure <$> unsafeFreeze d             <*> pure nbIters@@ -81,5 +84,5 @@         | i == nbIters = return ()         | otherwise    = do             (_, r) <- measuringNanoSeconds (evaluate $ f a)-            mutUnsafeWrite d (integralCast i) r+            mutUnsafeWrite d (from i) r             loop d (i+1)

@@ -1,5 +1,5 @@ Copyright (c) 2015-2017 Vincent Hanquez <vincent@snarc.org>-Copyright (c) 2017      Foundation Maintainers+Copyright (c) 2017-2018 Foundation Maintainers  All rights reserved. 

@@ -17,6 +17,7 @@     , readInt     , readInteger     , unpack+    , concat     ) where  import Prelude (undefined, Maybe(..))@@ -41,6 +42,8 @@ and _ _ = undefined all _ _ = undefined any _ _ = undefined+concat :: [ByteString] -> ByteString+concat _ = undefined unpack :: ByteString -> [Word8] unpack = undefined 

@@ -15,6 +15,7 @@     , and     , all     , any+    , concat     ) where  import Prelude (undefined)@@ -40,3 +41,4 @@ and _ _ = undefined all _ _ = undefined any _ _ = undefined+concat = undefined

@@ -13,6 +13,7 @@ import Foundation.String import BenchUtil.Common import BenchUtil.RefData+import qualified Basement.Block.Builder as Builder  import Sys @@ -179,6 +180,8 @@     , benchFoldr     , benchReverse     , benchFilter+    , benchMonoidConcat+    , benchBuilderBlock     , benchAll     , benchSort     , benchSort32@@ -204,11 +207,36 @@         t = ByteString.pack dat         v = Vector.fromList dat +    diffListByteArray :: ([UArray Word8] -> a)+                      -> ([Block Word8] -> b)+                      -> ([ByteString.ByteString] -> c)+                      -> ([Vector.Vector Word8] -> d)+                      -> [[Word8]]+                      -> [Benchmark]+    diffListByteArray uarrayBench blockBench bsBench vectorBench dat =+        [ bench "[UArray_W8]" $ whnf uarrayBench s+        , bench "[Block_W8]" $ whnf blockBench s'+#ifdef BENCH_ALL+        , bench "[ByteString]" $ whnf bsBench t+        , bench "[Vector_W8]" $ whnf vectorBench v+#endif+        ]+      where+        s = fromList <$> dat+        s' = fromList <$> dat+        t = ByteString.pack <$> dat+        v = Vector.fromList <$> dat+     allDat =         [ ("bs20", rdBytes20)         , ("bs200", rdBytes200)         , ("bs2000", rdBytes2000)         ]+    allListDat =+        [ ("listBs20", Prelude.replicate 20 rdBytes20)+        , ("listBs200", Prelude.replicate 200 rdBytes200)+        , ("listBs2000", Prelude.replicate 2000 rdBytes2000)+        ]     allDatSuffix s = fmap (first (\x -> x <> "-" <> s)) allDat      benchLength = bgroup "Length" $@@ -269,6 +297,15 @@         fmap (\(n, dat) -> bgroup n $ diffByteArray (filter (> 100)) (filter (> 100))                                                     (ByteString.filter (> 100))                                                     (Vector.filter (> 100)) dat) allDat++    benchMonoidConcat = bgroup "Monoid/mconcat" $+        fmap (\(n, dat) -> bgroup n $ diffListByteArray mconcat mconcat ByteString.concat Vector.concat dat) allListDat+    benchBuilderBlock = bgroup "Monoid/builder" $+        [ bench "[block Word8]" $ whnf builderConcat (Prelude.replicate 2000 (fromList rdBytes2000))+        ]+      where+        builderConcat :: [Block Word8] -> Block Word8+        builderConcat l = runST $ Builder.run $ mconcat (fmap Builder.emit l)      benchSort = bgroup "Sort" $ fmap (\(n, dat) ->         bgroup n $

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.18+version:             0.0.19 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -191,7 +191,7 @@                       BangPatterns                       DeriveDataTypeable   build-depends:     base >= 4.7 && < 5-                   , basement == 0.0.5+                   , basement == 0.0.6                    , ghc-prim   -- FIXME add suport for armel mipsel   --  CPP-options: -DARCH_IS_LITTLE_ENDIAN

@@ -8,11 +8,13 @@     ) where  import Foundation-import Foundation.Primitive import Foundation.Collection (nonEmpty_, NonEmpty) import Foundation.Check import Foundation.Monad +import Basement.From (from)+import Basement.Cast (cast)+ -- | convenient function to replicate thegiven Generator of `e` a randomly -- choosen amount of time. generateListOfElement :: Gen e -> Gen [e]@@ -21,19 +23,19 @@ -- | convenient function to generate up to a certain amount of time the given -- generator. generateListOfElementMaxN :: CountOf e -> Gen e -> Gen [e]-generateListOfElementMaxN (CountOf n) e = replicateBetween 0 (integralCast n) e+generateListOfElementMaxN n e = replicateBetween 0 (from n) e  generateNonEmptyListOfElement :: CountOf e -> Gen e -> Gen (NonEmpty [e])-generateNonEmptyListOfElement (CountOf n) e = nonEmpty_ <$> replicateBetween 1 (integralCast n) e+generateNonEmptyListOfElement n e = nonEmpty_ <$> replicateBetween 1 (from n) e  data RandomList = RandomList [Int]     deriving (Show,Eq)  instance Arbitrary RandomList where-    arbitrary = RandomList <$> replicateBetween 100 400 (integralCast <$> between (0,8))+    arbitrary = RandomList <$> replicateBetween 100 400 (cast <$> between (0,8))  replicateBetween n1 n2 f =     between (n1, n2) >>= \n -> replicateM (CountOf (toInt n)) f   where     toInt :: Word -> Int-    toInt = integralCast+    toInt = cast

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Test.Foundation.Network.IPv6@@ -27,6 +28,7 @@  testNetworkIPv6 :: Test testNetworkIPv6 = Group "IPv6"+#if __GLASGOW_HASKELL__ >= 710     [ Property "toTuple . fromTuple == id" $         forAll genIPv6Tuple $ \x -> x === toTuple (fromTuple x)     , Property "toString . fromString == id" $@@ -46,3 +48,6 @@         , Property "0:0::FFFF:129.144.52.38" $ (fromTuple (0,0,0,0,0,0xffff,0x8190,0x3426)) === (fromString "0:0::FFFF:129.144.52.38")         ]     ]+#else+    []+#endif

@@ -59,6 +59,21 @@               "this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"               "this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"         ]+    , Group "CaseMapping" +         [ Property "upper . upper == upper" $ \l ->+             let s = fromList l+              in upper (upper s) === upper s+         , CheckPlan "a should capitalize to A" $ validate "a" $ upper "a" == "A"+         , CheckPlan "b should capitalize to B" $ validate "b" $ upper "b" == "B"+         , CheckPlan "B should not capitalize" $ validate "B" $ upper "B" == "B"+         , CheckPlan "é should capitalize to É" $ validate "é" $ upper "é" == "É"+         , CheckPlan "ß should capitalize to SS" $ validate "ß" $ upper "ß" == "SS"+         , CheckPlan "ffl should capitalize to FFL" $ validate "ffl" $ upper "ffl" == "FFL"+         , CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "\0a" == "\0A"+         , CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "a\0a" == "A\0A"+         , CheckPlan "0a should capitalize to 0A" $ validate "0a" $ upper "\0\0" == "\0\0"+         , CheckPlan "00 should not capitalize" $ validate "00" $ upper "00" == "00"+        ]     {-     , testGroup "replace" [           testCase "indices '' 'bb' should raise an error" $ do