foundation 0.0.11 → 0.0.12

raw patch · 22 files changed

+716/−230 lines, 22 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Foundation.hs +4/−1
• Foundation/Array/Chunked/Unboxed.hs +0/−1
• Foundation/Array/Unboxed.hs +70/−8
• Foundation/Check/Main.hs +0/−4
• Foundation/Collection.hs +2/−0
• Foundation/Collection/Collection.hs +11/−1
• Foundation/List/ListN.hs +187/−0
• Foundation/List/SList.hs +0/−183
• Foundation/Primitive/BlockN.hs +136/−0
• Foundation/Primitive/Endianness.hs +2/−1
• Foundation/String.hs +3/−0
• Foundation/String/Builder.hs +0/−1
• Foundation/String/UTF8.hs +23/−0
• Foundation/System/Bindings/Time.hsc +1/−18
• README.md +11/−9
• cbits/foundation_system.h +3/−1
• foundation.cabal +8/−2
• tests/Test/Foundation/Misc.hs +12/−0
• tests/Test/Foundation/Primitive/BlockN.hs +64/−0
• tests/Test/Foundation/String/Base64.hs +163/−0
• tests/Tests.hs +9/−0

@@ -1,3 +1,10 @@+## 0.0.12++* Fix build windows building & time subsystem+* Add BlockN: Typed-fixed length block of memory+* Add Base64+* Add 'or' and 'and'+ ## 0.0.11  * Add Hlint support (configuration file), and default travis job

@@ -101,6 +101,8 @@     , (<>)       -- ** Collection     , Collection(..)+    , and+    , or     , Sequential(..)     , NonEmpty     , nonEmpty@@ -157,7 +159,8 @@ import           Data.Int (Int8, Int16, Int32, Int64) import           Foundation.String (String) import           Foundation.Array (UArray, Array, PrimType)-import           Foundation.Collection (Collection(..), Sequential(..), NonEmpty, nonEmpty, Foldable(..))+import           Foundation.Collection (Collection(..), and, or, Sequential(..)+                 , NonEmpty, nonEmpty, Foldable(..)) import qualified Foundation.IO.Terminal  import           GHC.Exts (IsString(..))

@@ -16,7 +16,6 @@     ( ChunkedUArray     ) where -import qualified Data.List import           Data.Typeable import           Control.Arrow ((***)) import           Foundation.Array.Boxed (Array)

@@ -96,8 +96,10 @@     , builderBuild     , builderBuild_     , toHexadecimal+    , toBase64Internal     ) where +import           Control.Monad (when) import           GHC.Prim import           GHC.Types import           GHC.Word@@ -1138,14 +1140,6 @@         loop mba (newOffset `offsetPlusE` replacementLen) offsetInOriginalString' xs {-# SPECIALIZE [3] replace :: UArray Word8 -> UArray Word8 -> UArray Word8 -> UArray Word8 #-} -foldl :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a-foldl f initialAcc vec = loop 0 initialAcc-  where-    len = length vec-    loop i acc-        | i .==# len = acc-        | otherwise  = loop (i+1) (f acc (unsafeIndex vec i))- foldr :: PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a foldr f initialAcc vec = loop 0   where@@ -1252,3 +1246,71 @@                 unsafeWrite ma dIdx     (W8# wHi)                 unsafeWrite ma (dIdx+1) (W8# wLo)                 loop (dIdx + 2) (sIdx+1)++toBase64Internal :: PrimType ty => Addr# -> UArray ty -> Bool -> UArray Word8+toBase64Internal table src padded+    | len == CountOf 0 = empty+    | otherwise = runST $ do+        ma <- new dstLen+        unsafeIndexer b8 (go ma)+        unsafeFreeze ma+  where+    b8 = unsafeRecast src+    !len = length b8+    !dstLen = outputLengthBase64 padded len+    !endOfs = Offset 0 `offsetPlusE` len++    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()+    go !ma !getAt = loop 0 0+      where+        eqChar = 0x3d :: Word8++        loop !sIdx !dIdx+            | sIdx >= endOfs = return ()+            | otherwise = do+                let !a = getAt sIdx+                    !b = if sIdx `offsetPlusE` CountOf 1 >= endOfs then 0 else getAt (sIdx `offsetPlusE` CountOf 1)+                    !c = if sIdx `offsetPlusE` CountOf 2 >= endOfs then 0 else getAt (sIdx `offsetPlusE` CountOf 2)++                let (w,x,y,z) = convert3 table a b c++                unsafeWrite ma dIdx w+                unsafeWrite ma (dIdx `offsetPlusE` CountOf 1) x++                if sIdx `offsetPlusE` CountOf 1 < endOfs+                    then+                        unsafeWrite ma (dIdx `offsetPlusE` CountOf 2) y+                    else+                        when padded (unsafeWrite ma (dIdx `offsetPlusE` CountOf 2) eqChar)+                if sIdx `offsetPlusE` CountOf 2 < endOfs+                    then+                        unsafeWrite ma (dIdx `offsetPlusE` CountOf 3) z+                    else+                        when padded (unsafeWrite ma (dIdx `offsetPlusE` CountOf 3) eqChar)++                loop (sIdx `offsetPlusE` CountOf 3) (dIdx `offsetPlusE` CountOf 4)++outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8+outputLengthBase64 padding (CountOf inputLenInt) = outputLength+  where+    outputLength = if padding then CountOf lenWithPadding else CountOf (lenWithPadding - numPadChars)++    lenWithPadding :: Int+    lenWithPadding = 4 * roundUp (Prelude.fromIntegral inputLenInt / 3.0 :: Double)++    numPadChars :: Int+    numPadChars = case inputLenInt `mod` 3 of+        1 -> 2+        2 -> 1+        _ -> 0++convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)+convert3 table (W8# a) (W8# b) (W8# c) =+    let !w = narrow8Word# (uncheckedShiftRL# a 2#)+        !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#)+        !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#)+        !z = and# c 0x3f##+     in (idx w, idx x, idx y, idx z)+  where+    idx :: Word# -> Word8+    idx i = W8# (indexWord8OffAddr# table (word2Int# i))

@@ -69,10 +69,6 @@   where     match acc s = or (flip isInfixOf currentTestName <$> testNameMatch cfg)       where currentTestName = fqTestName (s:acc)-    or [] = False-    or (x:xs)-        | x         = True-        | otherwise = or xs      testFilter acc x =         case x of

@@ -20,6 +20,8 @@     , forM     , forM_     , Collection(..)+    , and+    , or     , NonEmpty     , getNonEmpty     , nonEmpty

@@ -26,9 +26,11 @@     , nonEmpty     , nonEmpty_     , nonEmptyFmap+    , and+    , or     ) where -import           Foundation.Internal.Base+import           Foundation.Internal.Base hiding (and) import           Foundation.Primitive.Types.OffsetSize import           Foundation.Collection.Element import           Foundation.Collection.NonEmpty@@ -155,3 +157,11 @@     minimum = minimum . getNonEmpty     all p = all p . getNonEmpty     any p = any p . getNonEmpty++-- | Return True if all the elements in the collection are True+and :: (Collection col, Element col ~ Bool) => col -> Bool+and = all (== True)++-- | Return True if at least one element in the collection is True+or :: (Collection col, Element col ~ Bool) => col -> Bool+or = any (== True)

@@ -0,0 +1,187 @@+-- |+-- Module      : Foundation.List.ListN+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A Nat-sized list abstraction+--+-- Using this module is limited to GHC 7.10 and above.+--+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE UndecidableInstances      #-}+module Foundation.List.ListN+    ( ListN+    , toListN+    , unListN+    , length+    , create+    , createFrom+    , empty+    , singleton+    , uncons+    , cons+    , map+    , elem+    , foldl+    , append+    , minimum+    , maximum+    , head+    , tail+    , take+    , drop+    , zip, zip3, zip4, zip5+    , zipWith, zipWith3, zipWith4, zipWith5+    , replicateM+    ) where++import           Data.Proxy+import           Foundation.Internal.Base+import           Foundation.Primitive.Nat+import           Foundation.Numerical+import qualified Prelude+import qualified Control.Monad as M (replicateM)++impossible :: a+impossible = error "ListN: internal error: the impossible happened"++newtype ListN (n :: Nat) a = ListN { unListN :: [a] }++toListN :: forall (n :: Nat) a . (KnownNat n, NatWithinBound Int n) => [a] -> Maybe (ListN n a)+toListN l+    | expected == Prelude.fromIntegral (Prelude.length l) = Just (ListN l)+    | otherwise                                           = Nothing+  where+    expected = natValInt (Proxy :: Proxy n)++replicateM :: forall (n :: Nat) m a . (n <= 0x100000, Monad m, KnownNat n) => m a -> m (ListN n a)+replicateM action = ListN <$> M.replicateM (Prelude.fromIntegral $ natVal (Proxy :: Proxy n)) action++uncons :: CmpNat n 0 ~ 'GT => ListN n a -> (a, ListN (n-1) a)+uncons (ListN (x:xs)) = (x, ListN xs)+uncons _ = impossible++cons :: a -> ListN n a -> ListN (n+1) a+cons a (ListN l) = ListN (a : l)++empty :: ListN 0 a+empty = ListN []++length :: forall a (n :: Nat) . (KnownNat n, NatWithinBound Int n) => ListN n a -> Int+length _ = natValInt (Proxy :: Proxy n)++create :: forall a (n :: Nat) . KnownNat n => (Integer -> a) -> ListN n a+create f = ListN $ Prelude.map f [0..(len-1)]+  where+    len = natVal (Proxy :: Proxy n)++createFrom :: forall a (n :: Nat) (start :: Nat) . (KnownNat n, KnownNat start)+           => Proxy start -> (Integer -> a) -> ListN n a+createFrom p f = ListN $ Prelude.map f [idx..(idx+len)]+  where+    len = natVal (Proxy :: Proxy n)+    idx = natVal p++singleton :: a -> ListN 1 a+singleton a = ListN [a]++elem :: Eq a => a -> ListN n a -> Bool+elem a (ListN l) = Prelude.elem a l++append :: ListN n a -> ListN m a -> ListN (n+m) a+append (ListN l1) (ListN l2) = ListN (l1 <> l2)++maximum :: (Ord a, CmpNat n 0 ~ 'GT) => ListN n a -> a+maximum (ListN l) = Prelude.maximum l++minimum :: (Ord a, CmpNat n 0 ~ 'GT) => ListN n a -> a+minimum (ListN l) = Prelude.minimum l++head :: CmpNat n 0 ~ 'GT => ListN n a -> a+head (ListN (x:_)) = x+head _ = impossible++tail :: CmpNat n 0 ~ 'GT => ListN n a -> ListN (n-1) a+tail (ListN (_:xs)) = ListN xs+tail _ = impossible++take :: forall a (m :: Nat) (n :: Nat) . (KnownNat m, NatWithinBound Int m, m <= n) => ListN n a -> ListN m a+take (ListN l) = ListN (Prelude.take n l)+  where n = natValInt (Proxy :: Proxy m)++drop :: forall a d (m :: Nat) (n :: Nat) . (KnownNat d, NatWithinBound Int d, (n - m) ~ d, m <= n) => ListN n a -> ListN m a+drop (ListN l) = ListN (Prelude.drop n l)+  where n = natValInt (Proxy :: Proxy d)++map :: (a -> b) -> ListN n a -> ListN n b+map f (ListN l) = ListN (Prelude.map f l)++foldl :: (b -> a -> b) -> b -> ListN n a -> b+foldl f acc (ListN l) = Prelude.foldl f acc l++zip :: ListN n a -> ListN n b -> ListN n (a,b)+zip (ListN l1) (ListN l2) = ListN (Prelude.zip l1 l2)++zip3 :: ListN n a -> ListN n b -> ListN n c -> ListN n (a,b,c)+zip3 (ListN x1) (ListN x2) (ListN x3) = ListN (loop x1 x2 x3)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) = (l1,l2,l3) : loop l1s l2s l3s+        loop []       _        _        = []+        loop _        _        _        = impossible++zip4 :: ListN n a -> ListN n b -> ListN n c -> ListN n d -> ListN n (a,b,c,d)+zip4 (ListN x1) (ListN x2) (ListN x3) (ListN x4) = ListN (loop x1 x2 x3 x4)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) = (l1,l2,l3,l4) : loop l1s l2s l3s l4s+        loop []       _        _        _        = []+        loop _        _        _        _        = impossible++zip5 :: ListN n a -> ListN n b -> ListN n c -> ListN n d -> ListN n e -> ListN n (a,b,c,d,e)+zip5 (ListN x1) (ListN x2) (ListN x3) (ListN x4) (ListN x5) = ListN (loop x1 x2 x3 x4 x5)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) (l5:l5s) = (l1,l2,l3,l4,l5) : loop l1s l2s l3s l4s l5s+        loop []       _        _        _        _        = []+        loop _        _        _        _        _        = impossible++zipWith :: (a -> b -> x) -> ListN n a -> ListN n b -> ListN n x+zipWith f (ListN (v1:vs)) (ListN (w1:ws)) = ListN (f v1 w1 : unListN (zipWith f (ListN vs) (ListN ws)))+zipWith _ (ListN [])       _ = ListN []+zipWith _ _                _ = impossible++zipWith3 :: (a -> b -> c -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n x+zipWith3 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) =+    ListN (f v1 w1 x1 : unListN (zipWith3 f (ListN vs) (ListN ws) (ListN xs)))+zipWith3 _ (ListN []) _       _ = ListN []+zipWith3 _ _          _       _ = impossible++zipWith4 :: (a -> b -> c -> d -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n d+         -> ListN n x+zipWith4 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) (ListN (y1:ys)) =+    ListN (f v1 w1 x1 y1 : unListN (zipWith4 f (ListN vs) (ListN ws) (ListN xs) (ListN ys)))+zipWith4 _ (ListN []) _       _       _ = ListN []+zipWith4 _ _          _       _       _ = impossible++zipWith5 :: (a -> b -> c -> d -> e -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n d+         -> ListN n e+         -> ListN n x+zipWith5 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) (ListN (y1:ys)) (ListN (z1:zs)) =+    ListN (f v1 w1 x1 y1 z1 : unListN (zipWith5 f (ListN vs) (ListN ws) (ListN xs) (ListN ys) (ListN zs)))+zipWith5 _ (ListN []) _       _       _       _ = ListN []+zipWith5 _ _          _       _       _       _ = impossible

@@ -1,183 +0,0 @@--- |--- Module      : Foundation.List.SList--- License     : BSD-style--- Maintainer  : Vincent Hanquez <vincent@snarc.org>--- Stability   : experimental--- Portability : portable------ A Nat-sized list abstraction------ Using this module is limited to GHC 7.10 and above.----{-# LANGUAGE KindSignatures            #-}-{-# LANGUAGE DataKinds                 #-}-{-# LANGUAGE GADTs                     #-}-{-# LANGUAGE TypeOperators             #-}-{-# LANGUAGE TypeFamilies              #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE UndecidableInstances      #-}-module Foundation.List.SList-    ( SList-    , toSList-    , unSList-    , length-    , create-    , createFrom-    , empty-    , singleton-    , uncons-    , cons-    , map-    , elem-    , append-    , minimum-    , maximum-    , head-    , tail-    , take-    , drop-    , zip, zip3, zip4, zip5-    , zipWith, zipWith3, zipWith4, zipWith5-    , replicateM-    ) where--import           Data.Proxy-import           Foundation.Internal.Base-import           Foundation.Primitive.Nat-import           Foundation.Numerical-import qualified Prelude-import qualified Control.Monad as M (replicateM)--impossible :: a-impossible = error "SList: internal error: the impossible happened"--newtype SList (n :: Nat) a = SList { unSList :: [a] }--toSList :: forall (n :: Nat) a . (KnownNat n, NatWithinBound Int n) => [a] -> Maybe (SList n a)-toSList l-    | expected == Prelude.fromIntegral (Prelude.length l) = Just (SList l)-    | otherwise                                           = Nothing-  where-    expected = natValInt (Proxy :: Proxy n)--replicateM :: forall (n :: Nat) m a . (n <= 0x100000, Monad m, KnownNat n) => m a -> m (SList n a)-replicateM action = SList <$> M.replicateM (Prelude.fromIntegral $ natVal (Proxy :: Proxy n)) action--uncons :: CmpNat n 0 ~ 'GT => SList n a -> (a, SList (n-1) a)-uncons (SList (x:xs)) = (x, SList xs)-uncons _ = impossible--cons :: a -> SList n a -> SList (n+1) a-cons a (SList l) = SList (a : l)--empty :: SList 0 a-empty = SList []--length :: forall a (n :: Nat) . (KnownNat n, NatWithinBound Int n) => SList n a -> Int-length _ = natValInt (Proxy :: Proxy n)--create :: forall a (n :: Nat) . KnownNat n => (Integer -> a) -> SList n a-create f = SList $ Prelude.map f [0..(len-1)]-  where-    len = natVal (Proxy :: Proxy n)--createFrom :: forall a (n :: Nat) (start :: Nat) . (KnownNat n, KnownNat start)-           => Proxy start -> (Integer -> a) -> SList n a-createFrom p f = SList $ Prelude.map f [idx..(idx+len)]-  where-    len = natVal (Proxy :: Proxy n)-    idx = natVal p--singleton :: a -> SList 1 a-singleton a = SList [a]--elem :: Eq a => a -> SList n a -> Bool-elem a (SList l) = Prelude.elem a l--append :: SList n a -> SList m a -> SList (n+m) a-append (SList l1) (SList l2) = SList (l1 <> l2)--maximum :: (Ord a, CmpNat n 0 ~ 'GT) => SList n a -> a-maximum (SList l) = Prelude.maximum l--minimum :: (Ord a, CmpNat n 0 ~ 'GT) => SList n a -> a-minimum (SList l) = Prelude.minimum l--head :: CmpNat n 0 ~ 'GT => SList n a -> a-head (SList (x:_)) = x-head _ = impossible--tail :: CmpNat n 0 ~ 'GT => SList n a -> SList (n-1) a-tail (SList (_:xs)) = SList xs-tail _ = impossible--take :: forall a (m :: Nat) (n :: Nat) . (KnownNat m, NatWithinBound Int m, m <= n) => SList n a -> SList m a-take (SList l) = SList (Prelude.take n l)-  where n = natValInt (Proxy :: Proxy m)--drop :: forall a d (m :: Nat) (n :: Nat) . (KnownNat d, NatWithinBound Int d, (n - m) ~ d, m <= n) => SList n a -> SList m a-drop (SList l) = SList (Prelude.drop n l)-  where n = natValInt (Proxy :: Proxy d)--map :: (a -> b) -> SList n a -> SList n b-map f (SList l) = SList (Prelude.map f l)--zip :: SList n a -> SList n b -> SList n (a,b)-zip (SList l1) (SList l2) = SList (Prelude.zip l1 l2)--zip3 :: SList n a -> SList n b -> SList n c -> SList n (a,b,c)-zip3 (SList x1) (SList x2) (SList x3) = SList (loop x1 x2 x3)-  where loop (l1:l1s) (l2:l2s) (l3:l3s) = (l1,l2,l3) : loop l1s l2s l3s-        loop []       _        _        = []-        loop _        _        _        = impossible--zip4 :: SList n a -> SList n b -> SList n c -> SList n d -> SList n (a,b,c,d)-zip4 (SList x1) (SList x2) (SList x3) (SList x4) = SList (loop x1 x2 x3 x4)-  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) = (l1,l2,l3,l4) : loop l1s l2s l3s l4s-        loop []       _        _        _        = []-        loop _        _        _        _        = impossible--zip5 :: SList n a -> SList n b -> SList n c -> SList n d -> SList n e -> SList n (a,b,c,d,e)-zip5 (SList x1) (SList x2) (SList x3) (SList x4) (SList x5) = SList (loop x1 x2 x3 x4 x5)-  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) (l5:l5s) = (l1,l2,l3,l4,l5) : loop l1s l2s l3s l4s l5s-        loop []       _        _        _        _        = []-        loop _        _        _        _        _        = impossible--zipWith :: (a -> b -> x) -> SList n a -> SList n b -> SList n x-zipWith f (SList (v1:vs)) (SList (w1:ws)) = SList (f v1 w1 : unSList (zipWith f (SList vs) (SList ws)))-zipWith _ (SList [])       _ = SList []-zipWith _ _                _ = impossible--zipWith3 :: (a -> b -> c -> x)-         -> SList n a-         -> SList n b-         -> SList n c-         -> SList n x-zipWith3 f (SList (v1:vs)) (SList (w1:ws)) (SList (x1:xs)) =-    SList (f v1 w1 x1 : unSList (zipWith3 f (SList vs) (SList ws) (SList xs)))-zipWith3 _ (SList []) _       _ = SList []-zipWith3 _ _          _       _ = impossible--zipWith4 :: (a -> b -> c -> d -> x)-         -> SList n a-         -> SList n b-         -> SList n c-         -> SList n d-         -> SList n x-zipWith4 f (SList (v1:vs)) (SList (w1:ws)) (SList (x1:xs)) (SList (y1:ys)) =-    SList (f v1 w1 x1 y1 : unSList (zipWith4 f (SList vs) (SList ws) (SList xs) (SList ys)))-zipWith4 _ (SList []) _       _       _ = SList []-zipWith4 _ _          _       _       _ = impossible--zipWith5 :: (a -> b -> c -> d -> e -> x)-         -> SList n a-         -> SList n b-         -> SList n c-         -> SList n d-         -> SList n e-         -> SList n x-zipWith5 f (SList (v1:vs)) (SList (w1:ws)) (SList (x1:xs)) (SList (y1:ys)) (SList (z1:zs)) =-    SList (f v1 w1 x1 y1 z1 : unSList (zipWith5 f (SList vs) (SList ws) (SList xs) (SList ys) (SList zs)))-zipWith5 _ (SList []) _       _       _       _ = SList []-zipWith5 _ _          _       _       _       _ = impossible

@@ -0,0 +1,136 @@+-- |+-- Module      : Foundation.Primitive.Block+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- A Nat-sized version of Block+{-# LANGUAGE AllowAmbiguousTypes       #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Foundation.Primitive.BlockN+    ( BlockN+    , MutableBlockN+    , toBlockN+    , toBlock+    , singleton+    , replicate+    , thaw+    , freeze+    , index+    , map+    , foldl'+    , foldr+    , cons+    , snoc+    , elem+    , sub+    , uncons+    , unsnoc+    , splitAt+    , all+    , any+    , find+    , reverse+    , sortBy+    , intersperse+    )+where++import           Data.Proxy (Proxy(..))+import           Foundation.Internal.Base+import           Foundation.Primitive.Block (Block, MutableBlock(..), unsafeIndex)+import qualified Foundation.Primitive.Block as B+import           Foundation.Primitive.Monad (PrimMonad, PrimState)+import           Foundation.Primitive.Nat+import           Foundation.Primitive.NormalForm+import           Foundation.Primitive.Types (PrimType)+import           Foundation.Primitive.Types.OffsetSize (CountOf(..), Offset(..))++newtype BlockN (n :: Nat) a = BlockN { unBlock :: Block a } deriving (NormalForm, Eq, Show)++newtype MutableBlockN (n :: Nat) ty st = MutableBlockN { unMBlock :: MutableBlock ty st }++toBlockN :: forall n ty . (PrimType ty, KnownNat n, NatWithinBound Int n) => Block ty -> Maybe (BlockN n ty)+toBlockN b+    | expected == B.length b = Just (BlockN b)+    | otherwise = Nothing+  where+    expected = toCount @n++toBlock :: BlockN n ty -> Block ty+toBlock = unBlock++singleton :: PrimType ty => ty -> BlockN 1 ty+singleton a = BlockN (B.singleton a)++replicate :: forall n ty . (KnownNat n, NatWithinBound Int n, PrimType ty) => ty -> BlockN n ty+replicate a = BlockN (B.replicate (toCount @n) a)++thaw :: (KnownNat n, PrimMonad prim, PrimType ty) => BlockN n ty -> prim (MutableBlockN n ty (PrimState prim))+thaw b = MutableBlockN <$> B.thaw (unBlock b)++freeze ::  (PrimMonad prim, PrimType ty, NatWithinBound Int n) => MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty)+freeze b = BlockN <$> B.freeze (unMBlock b)++index :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, PrimType ty,  NatWithinBound Int i) => BlockN n ty -> ty+index b = unsafeIndex (unBlock b) (toOffset @i)++map :: (PrimType a, PrimType b) => (a -> b) -> BlockN n a -> BlockN n b+map f b = BlockN (B.map f (unBlock b))++foldl' :: PrimType ty => (a -> ty -> a) -> a -> BlockN n ty -> a+foldl' f acc b = B.foldl' f acc (unBlock b)++foldr :: PrimType ty => (ty -> a -> a) -> a -> BlockN n ty -> a+foldr f acc b = B.foldr f acc (unBlock b)++cons :: PrimType ty => ty -> BlockN n ty -> BlockN (n+1) ty+cons e = BlockN . B.cons e . unBlock++snoc :: PrimType ty => BlockN n ty -> ty -> BlockN (n+1) ty+snoc b = BlockN . B.snoc (unBlock b)++sub :: forall i j n ty . ((i <=? n) ~ 'True, (j <=? n) ~ 'True, (i <=? j) ~ 'True, PrimType ty, KnownNat i, NatWithinBound Int i, KnownNat j, NatWithinBound Int j) => BlockN n ty -> BlockN (j-i) ty+sub block = BlockN (B.sub (unBlock block) (toOffset @i) (toOffset @j))++uncons :: forall n ty . (CmpNat 0 n ~ 'LT, PrimType ty, KnownNat n, NatWithinBound Int n) => BlockN n ty -> (ty, BlockN (n-1) ty)+uncons b = (index @0 b, BlockN (B.sub (unBlock b) 1 (toOffset @n)))++unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, PrimType ty, NatWithinBound Int n) => BlockN n ty -> (BlockN (n-1) ty, ty)+unsnoc b = (BlockN (B.sub (unBlock b) 0 (toOffset @n)), undefined)++splitAt :: forall i n ty . (CmpNat i n ~ 'LT, PrimType ty, KnownNat i, NatWithinBound Int i) => BlockN n ty -> (BlockN i ty, BlockN (n-i) ty)+splitAt b =+    let (left, right) = B.splitAt (toCount @i) (unBlock b)+     in (BlockN left, BlockN right)++elem :: PrimType ty => ty -> BlockN n ty -> Bool+elem e b = B.elem e (unBlock b)++all :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool+all p b = B.all p (unBlock b)++any :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool+any p b = B.any p (unBlock b)++find :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Maybe ty+find p b = B.find p (unBlock b)++reverse :: PrimType ty => BlockN n ty -> BlockN n ty+reverse = BlockN . B.reverse . unBlock++sortBy :: PrimType ty => (ty -> ty -> Ordering) -> BlockN n ty -> BlockN n ty+sortBy f b = BlockN (B.sortBy f (unBlock b))++intersperse :: (CmpNat n 1 ~ 'GT, PrimType ty) => ty -> BlockN n ty -> BlockN (n+n-1) ty+intersperse sep b = BlockN (B.intersperse sep (unBlock b))++toCount :: forall n ty . (KnownNat n, NatWithinBound Int n) => CountOf ty+toCount = CountOf (natValInt (Proxy @n))++toOffset :: forall n ty . (KnownNat n, NatWithinBound Int n) => Offset ty+toOffset = Offset (natValInt (Proxy @n))

@@ -26,7 +26,8 @@ import Foundation.Internal.Base import Foundation.Internal.ByteSwap -#ifdef ARCH_IS_UNKNOWN_ENDIAN+#if defined(ARCH_IS_LITTLE_ENDIAN) || defined(ARCH_IS_BIG_ENDIAN)+#else import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (poke, peek)

@@ -34,6 +34,9 @@     , lower     , replace     , indices+    , toBase64+    , toBase64URL+    , toBase64OpenBSD     ) where  import Foundation.String.UTF8

@@ -18,7 +18,6 @@  import           Foundation.Internal.Base --import           Foundation.Internal.Semigroup-import           Foundation.Primitive.Types.OffsetSize import           Foundation.String.UTF8                (String) import qualified Foundation.String.UTF8 as S 

@@ -82,6 +82,9 @@     -- * Legacy utility     , lines     , words+    , toBase64+    , toBase64URL+    , toBase64OpenBSD     ) where  import           Foundation.Array.Unboxed           (UArray)@@ -1359,3 +1362,23 @@         | needle == haystackSub = True         | otherwise             = loop (i+1)       where haystackSub = C.take needleLen $ C.drop i haystack++-- | Transform string @src@ to base64 binary representation.+toBase64 :: String -> String+toBase64 (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ True+  where+    !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#++-- | Transform string @src@ to URL-safe base64 binary representation.+-- The result will be either padded or unpadded, depending on the boolean+-- @padded@ argument.+toBase64URL :: Bool -> String -> String+toBase64URL padded (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ padded+  where+    !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#++-- | Transform string @src@ to OpenBSD base64 binary representation.+toBase64OpenBSD :: String -> String+toBase64OpenBSD (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ False+  where+    !set = "./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"#

@@ -11,6 +11,7 @@  #include <time.h> #include <sys/time.h>+#include "foundation_system.h"  type CClockId = CInt data CTimeSpec@@ -34,24 +35,6 @@  size_CTimeT :: CSize size_CTimeT = #const sizeof(time_t)----------------------------------------------------------------------------#ifdef __APPLE__--#include <Availability.h>---- in OSX 10.12, clock_* API family is defined-#if !defined(__MAC_10_12) || __MAC_OS_X_VERSION_MIN_REQUIRED < __MAC_10_12-#define FOUNDATION_SYSTEM_API_NO_CLOCK-#endif--#endif---------------------------------------------------------------------------#ifdef _WIN32-#define FOUNDATION_SYSTEM_API_NO_CLOCK-#endif  ------------------------------------------------------------------------ #ifdef FOUNDATION_SYSTEM_API_NO_CLOCK

@@ -1,18 +1,20 @@ Foundation ========== -[![Build Status](https://travis-ci.org/haskell-foundation/foundation.png?branch=master)](https://travis-ci.org/haskell-foundation/foundation)-[![Coverage Status](https://coveralls.io/repos/github/haskell-foundation/foundation/badge.svg?branch=master)](https://coveralls.io/github/haskell-foundation/foundation?branch=master)-[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses)-[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org)+[![Linux Build Status](https://img.shields.io/travis/haskell-foundation/foundation/master.svg?label=Linux%20build)](https://travis-ci.org/haskell-foundation/foundation)+[![Windows Build Status](https://img.shields.io/appveyor/ci/vincenthz/foundation/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/vincenthz/foundation/branch/master) [![Doc](https://readthedocs.org/projects/haskell-foundation/badge/?version=latest)](http://haskell-foundation.readthedocs.io/en/latest/)--Documentation: [foundation on hackage](http://hackage.haskell.org/package/foundation)+[![Stackage version](https://www.stackage.org/package/foundation/badge/lts?label=Stackage)](https://www.stackage.org/package/foundation)+[![Hackage version](https://img.shields.io/hackage/v/foundation.svg?label=Hackage)](https://hackage.haskell.org/package/foundation)+[![BSD3](https://img.shields.io/badge/License-BSD-blue.svg)](https://en.wikipedia.org/wiki/BSD_License)+[![Haskell](https://img.shields.io/badge/Language-Haskell-yellowgreen.svg)](https://www.haskell.org)+[![Coverage Status](https://coveralls.io/repos/github/haskell-foundation/foundation/badge.svg?branch=master)](https://coveralls.io/github/haskell-foundation/foundation?branch=master) -ZuriHac 2017-============+Documentation: -_temporary chapter_. You can contact us on [Gitter](https://gitter.im/haskell-foundation/foundation). We are also room **1.261** if you are looking for us (you can find **Nei Mitchell** and **Vincent Hanquez**).+* [Read the doc](http://haskell-foundation.readthedocs.io/en/latest/)+* [Foundation on stackage](https://www.stackage.org/package/foundation)+* [Foundation on hackage](https://hackage.haskell.org/package/foundation)  Goals =====

@@ -3,6 +3,8 @@  #ifdef _WIN32    #define FOUNDATION_SYSTEM_WINDOWS+   #define FOUNDATION_SYSTEM_API_NO_CLOCK+    //define something for Windows (32-bit and 64-bit, this part is common)    #ifdef _WIN64       #define FOUNDATION_SYSTEM_WINDOWS_64@@ -30,7 +32,7 @@     #define FOUNDATION_SYSTEM_UNIX     #define FOUNDATION_SYSTEM_LINUX     // linux-#elif defined(__FreeBSD__) +#elif defined(__FreeBSD__)     #define FOUNDATION_SYSTEM_UNIX     #define FOUNDATION_SYSTEM_BSD     #define FOUNDATION_SYSTEM_FREEBSD

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.11+version:             0.0.12 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -239,8 +239,10 @@    if impl(ghc >= 7.10)     exposed-modules: Foundation.Tuple.Nth-                     Foundation.List.SList+                     Foundation.List.ListN                      Foundation.Primitive.Nat+  if impl(ghc >= 8.0)+    exposed-modules: Foundation.Primitive.BlockN    default-extensions: NoImplicitPrelude                       RebindableSyntax@@ -286,9 +288,13 @@                      Test.Foundation.Parser                      Test.Foundation.Array                      Test.Foundation.String+                     Test.Foundation.String.Base64                      Test.Foundation.Storable                      Test.Foundation.Misc                      Imports+  if impl(ghc >= 8.0)+    other-modules:   Test.Foundation.Primitive.BlockN+   default-extensions: NoImplicitPrelude                       RebindableSyntax   if flag(minimal-deps)

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Test.Foundation.Misc     ( testHexadecimal+    , testTime     , testUUID     ) where @@ -28,6 +30,16 @@ testHexadecimal = testGroup "hexadecimal"     [ testProperty  "UArray(W8)" $ \l ->         toList (toHexadecimal (fromListP (Proxy :: Proxy (UArray Word8)) l)) == hex l+    ]++testTime = testGroup "Time"+    [ testProperty "foundation_time_clock_gettime links properly" $+        $(let s :: String+              s = fromString "Hello"++              b :: Bool+              b = s == s+           in [| b |])     ]  testUUID = testGroup "UUID"

@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeOperators             #-}++module Test.Foundation.Primitive.BlockN+    ( testBlockN+    ) where++import           Imports+import           Data.Proxy (Proxy(..))+import           Foundation hiding (singleton, replicate, cons, uncons, elem)+import           Foundation.Primitive.Nat+import qualified Foundation.Primitive.Block as B+import           Foundation.Primitive.BlockN++testBlockN = testGroup "BlockN"+     [ testWithDifferentN+     , testCase "singleton" $ assertEq' (B.singleton (1 :: Int)) (toBlock (singleton 1))+     ]+++testWithDifferentN =+    testGroup "Multiple n" $ do+        Foo n <- ns+        [testBlock n]++testBlock :: forall n . (KnownNat n, NatWithinBound Int n) => Proxy n -> TestTree+testBlock nProxy =+  testGroup ("n = " <> show size)+    [ testCase "to/from block" $ assertEq' block (toBlock blockN)+    , testCase "replicate" $ assertEq' (B.replicate (CountOf size) (7 :: Int)) (toBlock (rep 7))+    , testCase "length . cons" $ assertEq' (B.length (toBlock (cons 42 blockN))) (CountOf (size+1))+    , testCase "elem" $ assertEq' (size == 0 || size `elem` blockN) True+    ]+  where+    rep :: Int -> BlockN n Int+    rep = replicate++    size = natValInt nProxy+    block = createBlockSized size+    Just blockN = toBlockN block :: Maybe (BlockN n Int)++createBlockSized :: Int -> B.Block Int+createBlockSized n =+    B.create (CountOf n) (const n)+++data Foo = forall a . (KnownNat a, NatWithinBound Int a) => Foo (Proxy a)++ns =+    [ Foo (Proxy :: Proxy 0)+    , Foo (Proxy :: Proxy 1)+    , Foo (Proxy :: Proxy 2)+    , Foo (Proxy :: Proxy 3)+    , Foo (Proxy :: Proxy 4)+    , Foo (Proxy :: Proxy 5)+    , Foo (Proxy :: Proxy 6)+    , Foo (Proxy :: Proxy 7)+    , Foo (Proxy :: Proxy 8)+    , Foo (Proxy :: Proxy 33)+    , Foo (Proxy :: Proxy 42)+    ]

@@ -0,0 +1,163 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+module Test.Foundation.String.Base64+    ( testBase64Refs+    ) where++import Imports ((@?=), testCase)++import Control.Monad+import Foundation+import Foundation.Numerical+import Foundation.String++import Test.Tasty+import Test.Tasty.QuickCheck++import Test.Data.Unicode++testBase64Refs :: TestTree+testBase64Refs = testGroup "String"+    [ testGroup "Base64" testBase64Cases+    ]++testBase64Cases :: [TestTree]+testBase64Cases =+    [ testGroup "toBase64"+        [ testProperty "length with padding" $ \(LUString l) ->+            let s = fromList l+                b = toBytes UTF8 s+                blen = length b+             in (length . toBytes UTF8 . toBase64 $ s) === outputLengthBase64 True blen+        , testProperty "valid chars" $ \(LUString l) ->+            let s = fromList l+                s64 = toBase64 s+                b64 = toBytes UTF8 s64+            in all ((||) <$> isPlainBase64Char <*> isPadding) b64 === True+        , testCase "test string: 'pleasure.'" $ do+            let s = fromList "pleasure."+            toBase64 s @?= fromList "cGxlYXN1cmUu"+        , testCase "test string: 'leasure.'" $ do+            let s = fromList "leasure."+            toBase64 s @?= fromList "bGVhc3VyZS4="+        , testCase "test string: 'easure.'" $ do+            let s = fromList "easure."+            toBase64 s @?= fromList "ZWFzdXJlLg=="+        , testCase "test string: 'asure.'" $ do+            let s = fromList "asure."+            toBase64 s @?= fromList "YXN1cmUu"+        , testCase "test string: 'sure.'" $ do+            let s = fromList "sure."+            toBase64 s @?= fromList "c3VyZS4="+        ]+    , testGroup "toBase64OpenBSD"+        [ testProperty "length without padding" $ \(LUString l) ->+            let s = fromList l+                b = toBytes UTF8 s+                blen = length b+            in (length . toBytes UTF8 . toBase64OpenBSD $ s) === outputLengthBase64 False blen+        , testProperty "valid chars" $ \(LUString l) ->+            let s = fromList l+                s64 = toBase64OpenBSD s+                b64 = toBytes UTF8 s64+            in all isBase64OpenBSDChar b64 === True+        ]+    , testGroup "toBase64URL"+        [ testProperty "length with padding" $ \(LUString l) ->+            let s = fromList l+                b = toBytes UTF8 s+                blen = length b+            in (length . toBytes UTF8 . toBase64URL True $ s) === outputLengthBase64 True blen,+          testProperty "length without padding" $ \(LUString l) ->+            let s = fromList l+                b = toBytes UTF8 s+                blen = length b+            in (length . toBytes UTF8 . toBase64URL False $ s) === outputLengthBase64 False blen+        , testProperty "valid chars (with padding)" $ \(LUString l) ->+            let s = fromList l+                s64 = toBase64URL True s+                b64 = toBytes UTF8 s64+            in all ((||) <$> isBase64URLChar <*> isPadding) b64 === True+        , testProperty "valid chars (without padding)" $ \(LUString l) ->+            let s = fromList l+                s64 = toBase64URL False s+                b64 = toBytes UTF8 s64+            in all isBase64URLChar b64 === True+        , testCase "test string: 'pleasure.'" $ do+            let s = fromList "pleasure."+            toBase64URL False s @?= fromList "cGxlYXN1cmUu"+        , testCase "test string: 'leasure.'" $ do+            let s = fromList "leasure."+            toBase64URL False s @?= fromList "bGVhc3VyZS4"+        , testCase "test string: '<empty>'" $ do+            let s = fromList ""+            toBase64URL False s @?= fromList ""+        , testCase "test string: '\\DC4\\251\\156\\ETX\\217~'" $ do+            -- the byte list represents "\DC4\251\156\ETX\217~"+            let s = fromBytesUnsafe . fromList $ [0x14, 0xfb, 0x9c, 0x03, 0xd9, 0x7e]+            toBase64URL False s @?= fromList "FPucA9l-"+        , testCase "test string: '\\DC4\\251\\156\\ETX\\217\\DEL'" $ do+            -- the byte list represents "\DC4\251\156\ETX\217\DEL"+            let s = fromBytesUnsafe . fromList $ [0x14, 0xfb, 0x9c, 0x03, 0xd9, 0x7f]+            toBase64URL False s @?= fromList "FPucA9l_"+        ]+    ]++outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8+outputLengthBase64 padding (CountOf inputLenInt) = outputLength+  where+    outputLength = if padding then CountOf lenWithPadding else CountOf (lenWithPadding - numPadChars)++    lenWithPadding :: Int+    lenWithPadding = 4 * roundUp (fromIntegral inputLenInt / 3.0 :: Double)++    numPadChars :: Int+    numPadChars = case inputLenInt `mod` 3 of+        1 -> 2+        2 -> 1+        _ -> 0++isPlainBase64Char :: Word8 -> Bool+isPlainBase64Char w = isAlphaDigit w || isPlus w || isSlash w++isBase64URLChar :: Word8 -> Bool+isBase64URLChar w = isAlphaDigit w || isDash w || isUnderscore w++isBase64OpenBSDChar :: Word8 -> Bool+isBase64OpenBSDChar w = isPeriod w || isSlash w || isAlphaDigit w++isPadding :: Word8 -> Bool+isPadding w = w == 61++isAlphaDigit :: Word8 -> Bool+isAlphaDigit w = isAlpha w || isDigit w++isAlpha :: Word8 -> Bool+isAlpha w = isUpperAlpha w || isLowerAlpha w++isUpperAlpha :: Word8 -> Bool+isUpperAlpha w = w - 65 <= 25++isLowerAlpha :: Word8 -> Bool+isLowerAlpha w = w - 97 <= 25++isDigit :: Word8 -> Bool+isDigit w = w - 48 <= 9++isPlus :: Word8 -> Bool+isPlus w = w == 43++isSlash :: Word8 -> Bool+isSlash w = w == 47++isDash :: Word8 -> Bool+isDash w = w == 45++isUnderscore :: Word8 -> Bool+isUnderscore w = w == 95++isPeriod :: Word8 -> Bool+isPeriod w = w == 46

@@ -24,7 +24,11 @@ import Test.Foundation.Conduit import Test.Foundation.Number import Test.Foundation.Array+import Test.Foundation.String.Base64 import Test.Foundation.ChunkedUArray+#if MIN_VERSION_base(4,9,0)+import Test.Foundation.Primitive.BlockN+#endif import Test.Foundation.String import Test.Foundation.Parser import Test.Foundation.Storable@@ -220,6 +224,7 @@ tests :: [TestTree] tests =     [ testArrayRefs+    , testBase64Refs     , testChunkedUArrayRefs     , Bits.tests     , testCollection "Bitmap"  (Proxy :: Proxy Bitmap)  arbitrary@@ -315,12 +320,16 @@             ( testZippableProps (Proxy :: Proxy (Array Int)) (Proxy :: Proxy (Array Char))                 arbitrary arbitrary )         ]+#if MIN_VERSION_base(4,9,0)+    , testBlockN+#endif     , testParsers     , testForeignStorableRefs     , testConduit     , testNetworkIPv4     , testNetworkIPv6     , testHexadecimal+    , testTime     , testUUID     , testGroup "Issues"         [ testGroup "218"