foundation 0.0.16 → 0.0.17

raw patch · 18 files changed

+124/−66 lines, 18 filesdep +gaugedep −criteriondep ~basedep ~basementPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: gauge

Dependencies removed: criterion

Dependency ranges changed: base, basement

API changes (from Hackage documentation)

Files

• CHANGELOG.md +26/−0
• Foundation.hs +2/−0
• Foundation/Array/Bitmap.hs +3/−0
• Foundation/Array/Chunked/Unboxed.hs +3/−0
• Foundation/Check/Arbitrary.hs +8/−0
• Foundation/Check/Main.hs +21/−11
• Foundation/Hashing/Hashable.hs +17/−11
• Foundation/Hashing/Hasher.hs +11/−21
• Foundation/Hashing/SipHash.hs +6/−7
• Foundation/List/DList.hs +5/−2
• Foundation/String/Builder.hs +3/−4
• Foundation/System/Bindings/Posix.hsc +3/−2
• Foundation/UUID.hs +0/−1
• Foundation/VFS/FilePath.hs +5/−2
• README.md +5/−0
• benchs/BenchUtil/Common.hs +2/−2
• foundation.cabal +3/−3
• tests/Test/Foundation/Primitive/BlockN.hs +1/−0

@@ -1,3 +1,29 @@+## 0.0.17++* Add Terminal capabilities: ANSI Escape, UTF8 codepage initialization, get dimensions+* Checks: Output now has colors+* Hashable: Add Word128 & Word256 & Boxed Array instances+* Semigroup: Compatibility with GHC 8.4+* Drop criterion for benchmark, now use Gauge+* Remove more UnboxedTuples from Foundation for easier loading with bytecode interpreter+* Reduce overhead of profiling common primitive operation like size and offset addition by+  preventing auto-caf in abstraction module+* Optimise UTF8 validation+* Optimise String toList (allow fusion)+* Optimise String reversal+* Merge different version of lowlevel array algorithms with one backed by a class.+* Zn64/Zn : Add Num, Additive, Subtractive, NormalForm, Arbitrary instances++## 0.0.16++* Re-organize type sized structure and add UVect and Vect+* Cleanup constraint in ListN, and add couple of combinators+* Add ExceptT+* Add some exception combinators (try,finally) that works with foundation classes.+* Tidy mutable algorithm for sorting removing redundant code+* Add primitive to convert Double/Float to Word64/Word32+* Cleanup withPtr / getAddr code to be safer+ ## 0.0.15  * Add Bits instance for Natural compat with 7.8

@@ -101,6 +101,7 @@     , Prelude.fromIntegral     , Prelude.realToFrac       -- ** Monoids+    , Basement.Compat.Semigroup.Semigroup     , Monoid (..)     , (<>)       -- ** Collection@@ -186,6 +187,7 @@ import           Basement.Environment (getArgs) import           Basement.Compat.NumLiteral import           Basement.Compat.Natural+import qualified Basement.Compat.Semigroup  import qualified Data.Maybe import qualified Data.Either

@@ -33,6 +33,7 @@ import qualified Basement.UArray as A import           Basement.UArray.Mutable (MUArray) import           Basement.Compat.Bifunctor (first, second, bimap)+import           Basement.Compat.Semigroup import           Basement.Exception import           Basement.Compat.Base import           Basement.Types.OffsetSize@@ -63,6 +64,8 @@     (==) = equal instance Ord Bitmap where     compare = vCompare+instance Semigroup Bitmap where+    (<>) = append instance Monoid Bitmap where     mempty  = empty     mappend = append

@@ -24,6 +24,7 @@ import           Basement.UArray (UArray) import qualified Basement.UArray as U import           Basement.Compat.Bifunctor+import           Basement.Compat.Semigroup import           Basement.Compat.Base import           Basement.Types.OffsetSize import           Basement.PrimType@@ -42,6 +43,8 @@ instance NormalForm (ChunkedUArray ty) where     toNormalForm (ChunkedUArray spine) = toNormalForm spine +instance Semigroup (ChunkedUArray a) where+    (<>) = append instance Monoid (ChunkedUArray a) where     mempty  = empty     mappend = append

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} module Foundation.Check.Arbitrary     ( Arbitrary(..)     , frequency@@ -19,6 +20,9 @@ import qualified Basement.Types.Char7 as Char7 import           Basement.Types.Word128 (Word128(..)) import           Basement.Types.Word256 (Word256(..))+#if __GLASGOW_HASKELL__ >= 710+import qualified Basement.Sized.List as ListN+#endif import           Foundation.Check.Gen import           Foundation.Random import           Foundation.Bits@@ -113,6 +117,10 @@ instance Arbitrary a => Arbitrary [a] where     arbitrary = genWithParams $ \params ->         fromList <$> (genMax (genMaxSizeArray params) >>= \i -> replicateM (integralCast i) arbitrary)+#if __GLASGOW_HASKELL__ >= 710+instance (Arbitrary a, KnownNat n, NatWithinBound Int n) => Arbitrary (ListN.ListN n a) where+    arbitrary = ListN.replicateM arbitrary+#endif  arbitraryInteger :: Gen Integer arbitraryInteger =

@@ -17,8 +17,10 @@  import           Basement.Imports import           Basement.IntegralConv+import           Basement.Bounded import           Basement.Types.OffsetSize-import           Foundation.System.Info (os, OS(..))+import qualified Basement.Terminal.ANSI as ANSI+import qualified Basement.Terminal as Terminal import           Foundation.Collection import           Foundation.Numerical import           Foundation.IO.Terminal@@ -88,6 +90,8 @@ -- | Run tests defaultMain :: Test -> IO () defaultMain allTestRoot = do+    Terminal.initialize+     -- parse arguments     ecfg <- flip parseArgs defaultConfig <$> getArgs     cfg  <- case ecfg of@@ -117,10 +121,10 @@     -- display a summary of the result and use the right exit code     summary cfg         | kos > 0 = do-            putStrLn $ "Failed " <> show kos <> " out of " <> show tot+            putStrLn $ red <> "Failed " <> show kos <> " out of " <> show tot <> reset             exitFailure         | otherwise = do-            putStrLn $ "Succeed " <> show oks <> " test(s)"+            putStrLn $ green <> "Succeed " <> show oks <> " test(s)" <> reset             exitSuccess       where         oks = testPassed cfg@@ -197,19 +201,25 @@         , if nb == 1 then " test)" else " tests)"         ] +unicodeEnabled :: Bool+unicodeEnabled = True+ successString :: String-successString = case os of-    Right Linux -> " ✓ "-    Right OSX   -> " ✓ "-    _           -> "[SUCCESS]"+successString+    | unicodeEnabled = green <> " ✓ " <> reset+    | otherwise      = green <> "[SUCCESS] " <> reset {-# NOINLINE successString #-}  failureString :: String-failureString = case os of-    Right Linux -> " ✗ "-    Right OSX   -> " ✗ "-    _           -> "[ ERROR ]"+failureString+    | unicodeEnabled = red <> " ✗ " <> reset+    | otherwise      = red <> "[ ERROR ] " <> reset {-# NOINLINE failureString #-}++reset, green, red :: ANSI.Escape+reset = ANSI.sgrReset+green = ANSI.sgrForeground (zn64 2) True+red = ANSI.sgrForeground (zn64 1) True  displayPropertyFailed :: String -> CountOf TestResult -> String -> CheckMain () displayPropertyFailed name (CountOf nb) w = do

@@ -12,15 +12,17 @@     ( Hashable(..)     ) where -import Basement.Compat.Base-import Basement.Compat.Natural-import Basement.IntegralConv-import Basement.Numerical.Multiplicative-import Foundation.Array-import Foundation.Tuple-import Foundation.String-import Foundation.Collection.Foldable-import Foundation.Hashing.Hasher+import           Basement.Imports+import           Basement.Compat.Natural+import           Basement.Types.Word128+import           Basement.Types.Word256+import           Basement.IntegralConv+import           Basement.Numerical.Multiplicative+import qualified Basement.BoxedArray as A+import           Foundation.Tuple+import           Foundation.String+import           Foundation.Collection.Foldable+import           Foundation.Hashing.Hasher  -- | Type with the ability to be hashed --@@ -42,6 +44,10 @@     hashMix w = hashMix32 w instance Hashable Word64 where     hashMix w = hashMix64 w+instance Hashable Word128 where+    hashMix (Word128 w1 w2) = hashMix64 w2 . hashMix64 w1+instance Hashable Word256 where+    hashMix (Word256 w1 w2 w3 w4) = hashMix64 w4 . hashMix64 w3 . hashMix64 w2 . hashMix64 w1 instance Hashable Natural where     hashMix n iacc         | n == 0    = hashMix8 0 iacc@@ -77,8 +83,8 @@ -- collection type instances instance PrimType a => Hashable (UArray a) where     hashMix ba = hashMixBytes ba---instance Hashable a => Hashable (Array a) where---    hashMix arr st = foldl' (flip hashMix) st arr+instance Hashable a => Hashable (A.Array a) where+    hashMix arr st = A.foldl' (flip hashMix) st arr  -- combined instances instance Hashable a => Hashable [a] where

@@ -1,4 +1,3 @@-{-# LANGUAGE UnboxedTuples #-} module Foundation.Hashing.Hasher     ( Hasher(..)     ) where@@ -40,35 +39,26 @@     -- | Mix a Word16 into the state and return the new state     hashMix16 :: Word16 -> st -> st     hashMix16 w st = hashMix8 w2 $ hashMix8 w1 st-      where (# !w1, !w2 #) = unWord16 w+      where+        !w1 = integralDownsize (w `unsafeShiftR` 8)+        !w2 = integralDownsize w      -- | Mix a Word32 into the state and return the new state     hashMix32 :: Word32 -> st -> st     hashMix32 w st = hashMix8 w4 $ hashMix8 w3 $ hashMix8 w2 $ hashMix8 w1 st-      where (# !w1, !w2, !w3, !w4 #) = unWord32 w+      where+        !w1 = integralDownsize (w `unsafeShiftR` 24)+        !w2 = integralDownsize (w `unsafeShiftR` 16)+        !w3 = integralDownsize (w `unsafeShiftR` 8)+        !w4 = integralDownsize w      -- | Mix a Word64 into the state and return the new state     hashMix64 :: Word64 -> st -> st     hashMix64 w st = hashMix32 w2 $ hashMix32 w1 st-      where (# !w1, !w2 #) = unWord64_32 w+      where+        !w1 = integralDownsize (w `unsafeShiftR` 32)+        !w2 = integralDownsize w      -- | Mix an arbitrary sized unboxed array and return the new state     hashMixBytes :: A.PrimType e => UArray e -> st -> st     hashMixBytes ba st = A.foldl' (flip hashMix8) st (A.unsafeRecast ba)--unWord16 :: Word16 -> (# Word8, Word8 #)-unWord16 w = (# integralDownsize (w `unsafeShiftR` 8)-             ,  integralDownsize w #)-{-# INLINE unWord16 #-}--unWord32 :: Word32 -> (# Word8, Word8, Word8, Word8 #)-unWord32 w = (# integralDownsize (w `unsafeShiftR` 24)-             ,  integralDownsize (w `unsafeShiftR` 16)-             ,  integralDownsize (w `unsafeShiftR` 8)-             ,  integralDownsize w #)-{-# INLINE unWord32 #-}--unWord64_32 :: Word64 -> (# Word32, Word32 #)-unWord64_32 w = (# integralDownsize (w `unsafeShiftR` 32)-                ,  integralDownsize w #)-{-# INLINE unWord64_32 #-}

@@ -10,7 +10,6 @@ -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-} module Foundation.Hashing.SipHash     ( SipKey(..)     , SipHash(..)@@ -93,20 +92,20 @@                        (k0 `xor` 0x6c7967656e657261)                        (k1 `xor` 0x7465646279746573) -mix8Prim :: Int -> Word8 -> InternalState -> SipIncremental -> (# InternalState, SipIncremental #)+mix8Prim :: Int -> Word8 -> InternalState -> SipIncremental -> (InternalState, SipIncremental) mix8Prim !c !w !ist !incremental =     case incremental of-        SipIncremental7 acc -> (# process c ist ((acc `unsafeShiftL` 8) .|. Prelude.fromIntegral w), SipIncremental0 #)+        SipIncremental7 acc -> (process c ist ((acc `unsafeShiftL` 8) .|. Prelude.fromIntegral w), SipIncremental0)         SipIncremental6 acc -> doAcc SipIncremental7 acc         SipIncremental5 acc -> doAcc SipIncremental6 acc         SipIncremental4 acc -> doAcc SipIncremental5 acc         SipIncremental3 acc -> doAcc SipIncremental4 acc         SipIncremental2 acc -> doAcc SipIncremental3 acc         SipIncremental1 acc -> doAcc SipIncremental2 acc-        SipIncremental0     -> (# ist, SipIncremental1 $ Prelude.fromIntegral w #)+        SipIncremental0     -> (ist, SipIncremental1 $ Prelude.fromIntegral w)   where     doAcc constr acc =-        (# ist , constr ((acc .<<. 8) .|. Prelude.fromIntegral w) #)+        (ist , constr ((acc .<<. 8) .|. Prelude.fromIntegral w))  mix8 :: Int -> Word8 -> Sip -> Sip mix8 !c !w (Sip ist incremental len) =@@ -205,7 +204,7 @@         loop8 !st !incr !ofs !l = loop1 st incr ofs l         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+            Just l1 -> let (!st', !incr') = mix8Prim c (primBaIndex ba ofs) st incr                         in loop1 st' incr' (ofs + Offset 1) l1      to64 :: Int -> Word8 -> Word64@@ -231,7 +230,7 @@         loop8 !st !incr !ofs !l = loop1 st incr ofs l         loop1 !st !incr !ofs !l = case l - 1 of           Nothing -> Sip st incr (currentLen + totalLen)-          Just l1 -> let (# st', incr' #) = mix8Prim c (primAddrIndex ptr ofs) st incr+          Just l1 -> let (!st', !incr') = mix8Prim c (primAddrIndex ptr ofs) st incr                       in loop1 st' incr' (ofs + Offset 1) l1  doRound :: InternalState -> InternalState

@@ -12,8 +12,9 @@     ) where  import Basement.Compat.Base-import Foundation.Collection+import Basement.Compat.Semigroup import Basement.Compat.Bifunctor+import Foundation.Collection  newtype DList a = DList { unDList :: [a] -> [a] }   deriving (Typeable)@@ -29,9 +30,11 @@  instance IsList (DList a) where     type Item (DList a) = a-    fromList = DList . (<>)+    fromList = DList . (Basement.Compat.Semigroup.<>)     toList = flip unDList [] +instance Semigroup (DList a) where+    (<>) dl1 dl2 = DList $ unDList dl1 . unDList dl2 instance Monoid (DList a) where     mempty = DList id     mappend dl1 dl2 = DList $ unDList dl1 . unDList dl2

@@ -17,7 +17,7 @@     ) where  import           Basement.Compat.Base---import           Basement.Compat.Semigroup+import           Basement.Compat.Semigroup import           Basement.String                (String) import qualified Basement.String as S @@ -26,9 +26,8 @@ instance IsString Builder where     fromString = E . fromString ---instance Semigroup Builder where---    (<>) = append-+instance Semigroup Builder where+    (<>) = append instance Monoid Builder where     mempty = empty     mappend = append

@@ -11,6 +11,7 @@ -- Functions defined by the POSIX standards -- -----------------------------------------------------------------------------+{-# LANGUAGE CApiFFI #-} {-# OPTIONS_HADDOCK hide #-} module Foundation.System.Bindings.Posix    where@@ -348,9 +349,9 @@ foreign import ccall unsafe "close"     sysPosixClose :: CFd -> IO CInt -foreign import ccall unsafe "fcntl"+foreign import capi "fcntl.h fcntl"     sysPosixFnctlNoArg :: CFd -> CInt -> IO CInt-foreign import ccall unsafe "fcntl"+foreign import capi "fcntl.h fcntl"     sysPosixFnctlPtr :: CFd -> CInt -> Ptr a -> IO CInt  foreign import ccall unsafe "ftruncate"

@@ -1,4 +1,3 @@-{-# LANGUAGE UnboxedTuples    #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} 

@@ -35,6 +35,7 @@     ) where  import Basement.Compat.Base+import Basement.Compat.Semigroup import Foundation.Collection import Foundation.Array import Foundation.String (Encoding(..), ValidationFailure, toBytes, fromBytes, String)@@ -184,9 +185,11 @@ hasContigueSeparators (x1:x2:xs) =     (isSeparator x1 && x1 == x2) || hasContigueSeparators xs +instance Semigroup FileName where+    (<>) (FileName a) (FileName b) = FileName $ a `mappend` b instance Monoid FileName where-      mempty = FileName mempty-      mappend (FileName a) (FileName b) = FileName $ a `mappend` b+    mempty = FileName mempty+    mappend (FileName a) (FileName b) = FileName $ a `mappend` b  instance Path FilePath where     type PathEnt FilePath = FileName

@@ -16,6 +16,11 @@ * [Foundation on stackage](https://www.stackage.org/package/foundation) * [Foundation on hackage](https://hackage.haskell.org/package/foundation) +Discuss:++* [FP Chat](https://fpchat-invite.herokuapp.com) `#haskell-foundation` channel+* [Gitter](https://gitter.im/haskell-foundation/foundation)+ Goals ===== 

@@ -12,8 +12,8 @@     , nf     ) where -import           Criterion.Main hiding (bgroup, bench)-import qualified Criterion.Main as C+import           Gauge.Main hiding (bgroup, bench)+import qualified Gauge.Main as C import           Foundation  fbench = bench "foundation"

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.16+version:             0.0.17 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -192,7 +192,7 @@                       BangPatterns                       DeriveDataTypeable   build-depends:     base >= 4.7 && < 5-                   , basement == 0.0.3+                   , basement == 0.0.4                    , ghc-prim   -- FIXME add suport for armel mipsel   --  CPP-options: -DARCH_IS_LITTLE_ENDIAN@@ -274,7 +274,7 @@   if flag(minimal-deps) || impl(ghc < 7.10)     buildable: False   else-    build-depends:     base >= 4, criterion, basement, foundation+    build-depends:     base >= 4, gauge, basement, foundation     if flag(bench-all)       cpp-options:     -DBENCH_ALL       build-depends:   text, attoparsec, vector, bytestring

@@ -11,6 +11,7 @@ import           Data.Proxy (Proxy(..)) import           Foundation hiding (singleton, replicate, cons, uncons, elem) import           Basement.Nat+import           Basement.Types.OffsetSize import qualified Basement.Block as B import           Basement.Sized.Block import           Basement.From