foundation 0.0.19 → 0.0.20

raw patch · 27 files changed

+542/−48 lines, 27 filesdep +template-haskelldep ~basedep ~basementdep ~gaugePVP ok

version bump matches the API change (PVP)

Dependencies added: template-haskell

Dependency ranges changed: base, basement, gauge

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• Foundation/Array/Bitmap.hs +3/−0
• Foundation/Check.hs +1/−0
• Foundation/Check/Main.hs +4/−3
• Foundation/Check/Property.hs +17/−3
• Foundation/Collection/Copy.hs +17/−0
• Foundation/Collection/Element.hs +13/−0
• Foundation/Collection/Foldable.hs +32/−2
• Foundation/Collection/Indexed.hs +43/−3
• Foundation/Collection/Sequential.hs +3/−3
• Foundation/Format/CSV.hs +232/−0
• Foundation/Hashing/FNV.hs +9/−8
• Foundation/Hashing/SipHash.hs +3/−2
• Foundation/Network/IPv6.hs +0/−1
• Foundation/Timing/Main.hs +0/−1
• Foundation/UUID.hs +0/−1
• benchs/BenchUtil/Common.hs +2/−2
• benchs/BenchUtil/RefData.hs +12/−0
• benchs/Fake/Text.hs +4/−0
• benchs/Main.hs +10/−0
• foundation.cabal +28/−5
• tests/Checks.hs +2/−1
• tests/Scripts/Link.hs +17/−0
• tests/Test/Foundation/Format.hs +14/−0
• tests/Test/Foundation/Format/CSV.hs +64/−0
• tests/Test/Foundation/Misc.hs +0/−12
• tests/Test/Foundation/String.hs +1/−1

@@ -1,3 +1,14 @@+## 0.0.20++* Reduce algorithm duplication between native and foreign backend+* Improve Unicode cases algorithm and increase testing+* Add CSV Builder+* Add a BitOps & FiniteBitOps classes to have better types than the Data.Bits.Bits class+* Improve BlockN operations+* Improve ListN operations+* Allow compilation with gauge 0.1+* Add support for [haskell-ci](https://github.com/vincenthz/haskell-ci)+ ## 0.0.19  * Add Block, UArray, String Builder

@@ -39,6 +39,7 @@ import           Basement.Compat.Base import           Basement.Types.OffsetSize import           Basement.Monad+ import qualified Foundation.Collection as C import           Foundation.Numerical import           Data.Bits@@ -146,6 +147,8 @@     mutUnsafeRead = unsafeRead     mutWrite = write     mutRead = read++  bitmapIndex :: Offset Bool -> (Offset Word32, Int) bitmapIndex (Offset !i) = (Offset (i .>>. shiftPerTy), i .&. maskPerTy)

@@ -26,6 +26,7 @@     , IsProperty(..)     , (===)     , propertyCompare+    , propertyCompareWith     , propertyAnd     , propertyFail     , forAll

@@ -34,7 +34,6 @@ import           Foundation.Random import           Foundation.Monad import           Foundation.Monad.State-import           Control.Monad (when) import           Data.Maybe (catMaybes)  nbFail :: TestResult -> HasFailures@@ -273,8 +272,10 @@         then return (GroupResult name 0 (planValidations st) [])         else do             displayCurrent name-            forM_ fails $ \f ->-                liftIO $ putStrLn $ show f+            forM_ fails $ \(PropertyResult name' nb r) ->+                case r of+                    PropertySuccess  -> whenVerbose $ displayPropertySucceed (name <> ": " <> name') nb+                    PropertyFailed w -> whenErrorOnly $ displayPropertyFailed (name <> ": " <> name') nb w             return (GroupResult name (length fails) (planValidations st) fails)  testProperty :: String -> Property -> CheckMain TestResult

@@ -12,6 +12,7 @@     , forAll     , (===)     , propertyCompare+    , propertyCompareWith     , propertyAnd     , propertyFail     ) where@@ -92,9 +93,22 @@                 -> a                -- ^ value left of the operator                 -> a                -- ^ value right of the operator                 -> PropertyCheck-propertyCompare name op a b =-    let sa = pretty a Proxy-        sb = pretty b Proxy+propertyCompare name op = propertyCompareWith name op (flip pretty Proxy)++-- | A property that check for a specific comparaison of its 2 members.+--+-- This is equivalent to `===` but with `compare` and a given method to+-- pretty print the values.+--+propertyCompareWith :: String           -- ^ name of the function used for comparaison, e.g. (<)+                    -> (a -> a -> Bool) -- ^ function used for value comparaison+                    -> (a -> String)    -- ^ function used to pretty print the values+                    -> a                -- ^ value left of the operator+                    -> a                -- ^ value right of the operator+                    -> PropertyCheck+propertyCompareWith name op display a b =+    let sa = display a+        sb = display b      in PropertyBinaryOp (a `op` b) name sa sb  -- | A conjuctive property composed of 2 properties that need to pass

@@ -1,14 +1,24 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}+ module Foundation.Collection.Copy     ( Copy(..)     ) where  import           GHC.ST (runST) import           Basement.Compat.Base ((>>=))+import           Basement.Nat+import           Basement.Types.OffsetSize import qualified Basement.Block as BLK import qualified Basement.UArray as UA import qualified Basement.BoxedArray as BA import qualified Basement.String as S +#if MIN_VERSION_base(4,9,0)+import qualified Basement.Sized.Block as BLKN+import qualified Basement.Sized.List  as LN+#endif+ class Copy a where     copy :: a -> a instance Copy [ty] where@@ -21,3 +31,10 @@     copy = BA.copy instance Copy S.String where     copy = S.copy++#if MIN_VERSION_base(4,9,0)+instance Copy (LN.ListN n ty) where+    copy a = a+instance (Countable ty n, UA.PrimType ty, KnownNat n) => Copy (BLKN.BlockN n ty) where+    copy blk = runST (BLKN.thaw blk >>= BLKN.freeze)+#endif

@@ -5,6 +5,9 @@ -- Stability   : experimental -- Portability : portable --++{-# LANGUAGE CPP #-}+ module Foundation.Collection.Element     ( Element     ) where@@ -18,6 +21,11 @@ import Basement.Types.Char7 (Char7) import Basement.NonEmpty +#if MIN_VERSION_base(4,9,0)+import Basement.Sized.Block (BlockN)+import Basement.Sized.List  (ListN)+#endif+ -- | Element type of a collection type family Element container type instance Element [a] = a@@ -27,3 +35,8 @@ type instance Element String = Char type instance Element AsciiString = Char7 type instance Element (NonEmpty a) = Element a++#if MIN_VERSION_base(4,9,0)+type instance Element (BlockN n ty) = ty+type instance Element (ListN n a) = a+#endif

@@ -7,6 +7,14 @@ -- -- A mono-morphic re-thinking of the Foldable class --++{-# LANGUAGE CPP                   #-}++#if MIN_VERSION_base(4,9,0)+{-# LANGUAGE DataKinds     #-}+{-# LANGUAGE TypeOperators #-}+#endif+ module Foundation.Collection.Foldable     ( Foldable(..)     , Fold1able(..)@@ -15,11 +23,17 @@ import           Basement.Compat.Base import           Foundation.Collection.Element import           Basement.NonEmpty+import           Basement.Nat import qualified Data.List import qualified Basement.UArray as UV import qualified Basement.Block as BLK import qualified Basement.BoxedArray as BA +#if MIN_VERSION_base(4,9,0)+import qualified Basement.Sized.List as LN+import qualified Basement.Sized.Block as BLKN+#endif+ -- | Give the ability to fold a collection on itself class Foldable collection where     -- | Left-associative fold of a structure.@@ -74,12 +88,22 @@     foldr = BLK.foldr     foldl' = BLK.foldl' +#if MIN_VERSION_base(4,9,0)+instance Foldable (LN.ListN n a) where+    foldr = LN.foldr+    foldl' = LN.foldl'+instance UV.PrimType ty => Foldable (BLKN.BlockN n ty) where+    foldr = BLKN.foldr+    foldl' = BLKN.foldl'+#endif+ ---------------------------- -- Fold1able instances ----------------------------+ instance Fold1able [a] where-  foldr1 f  = Data.List.foldr1 f . getNonEmpty-  foldl1' f = Data.List.foldl1' f . getNonEmpty+    foldr1  f = Data.List.foldr1  f . getNonEmpty+    foldl1' f = Data.List.foldl1' f . getNonEmpty  instance UV.PrimType ty => Fold1able (UV.UArray ty) where     foldr1 = UV.foldr1@@ -90,3 +114,9 @@ instance UV.PrimType ty => Fold1able (BLK.Block ty) where     foldr1  = BLK.foldr1     foldl1' = BLK.foldl1'++#if MIN_VERSION_base(4,9,0)+instance (1 <= n) => Fold1able (LN.ListN n a) where+    foldr1  f = LN.foldr1  f . getNonEmpty+    foldl1' f = LN.foldl1' f . getNonEmpty+#endif

@@ -5,12 +5,20 @@ -- Stability   : experimental -- Portability : portable ---{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE CPP                   #-}++#if MIN_VERSION_base(4,9,0)+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE UndecidableInstances  #-}+#endif+ module Foundation.Collection.Indexed     ( IndexedCollection(..)     ) where  import           Basement.Compat.Base+import           Basement.Numerical.Additive ((+)) import           Basement.Types.OffsetSize import           Foundation.Collection.Element import qualified Data.List@@ -20,6 +28,12 @@ import qualified Basement.Exception as A import qualified Basement.String as S +#if MIN_VERSION_base(4,9,0)+import qualified Basement.Sized.Block as BLKN+import qualified Basement.Sized.List  as LN+import           Basement.Nat+#endif+ -- | Collection of elements that can indexed by int class IndexedCollection c where     (!) :: c -> Offset (Element c) -> Maybe (Element c)@@ -36,14 +50,14 @@ instance UV.PrimType ty => IndexedCollection (BLK.Block ty) where     (!) l n         | A.isOutOfBound n (BLK.length l) = Nothing-        | otherwise                           = Just $ BLK.index l n+        | otherwise                       = Just $ BLK.index l n     findIndex predicate c = loop 0       where         !len = BLK.length c         loop i             | i .==# len                      = Nothing             | predicate (BLK.unsafeIndex c i) = Just i-            | otherwise                       = Nothing+            | otherwise                       = loop (i + 1)  instance UV.PrimType ty => IndexedCollection (UV.UArray ty) where     (!) l n@@ -72,3 +86,29 @@ instance IndexedCollection S.String where     (!) = S.index     findIndex = S.findIndex++#if MIN_VERSION_base(4,9,0)+instance (NatWithinBound Int n, KnownNat n) => IndexedCollection (LN.ListN n a) where+    (!) c off+        | A.isOutOfBound off (LN.length c) = Nothing+        | otherwise                        = Just $ LN.index c off+    findIndex predicate c = loop 0+      where+        !len = LN.length c+        loop i+            | i .==# len               = Nothing+            | predicate (LN.index c i) = Just i+            | otherwise                = loop (i + 1)++instance (NatWithinBound (CountOf ty) n, KnownNat n, UV.PrimType ty) => IndexedCollection (BLKN.BlockN n ty) where+    (!) c off+        | A.isOutOfBound off (BLKN.length c) = Nothing+        | otherwise                          = Just $ BLKN.index c off+    findIndex predicate c = loop 0+      where+        !len = BLKN.length c+        loop i+            | i .==# len                 = Nothing+            | predicate (BLKN.index c i) = Just i+            | otherwise                  = loop (i + 1)+#endif

@@ -76,11 +76,11 @@     break :: (Element c -> Bool) -> c -> (c,c)     break predicate = span (not . predicate) -    -- | Split a collection when the predicate return true+    -- | Split a collection when the predicate return true starting from the end of the collection     breakEnd :: (Element c -> Bool) -> c -> (c,c)     breakEnd predicate = spanEnd (not . predicate) -    -- | Split a collection when the predicate return true starting from the end of the collection+    -- | Split a collection at the given element     breakElem :: Eq (Element c) => Element c -> c -> (c,c)     breakElem c = break (== c) @@ -116,7 +116,7 @@     -- | Filter all the elements that satisfy the predicate     filter :: (Element c -> Bool) -> c -> c -    -- | Partition the elements thtat satisfy the predicate and those that don't+    -- | Partition the elements that satisfy the predicate and those that don't     partition :: (Element c -> Bool) -> c -> (c,c)     partition predicate c = (filter predicate c, filter (not . predicate) c) 

@@ -0,0 +1,232 @@+-- |+-- Module      : Foundation.Format.CSV+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+-- Provies the support for Comma Separated Value++{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE FlexibleInstances          #-}++module Foundation.Format.CSV+    (-- * CSV+      CSV++    -- ** Builder+    -- ** String Bulider+    , csvStringBuilder+    , rowStringBuilder+    , fieldStringBuilder+    -- ** Block Builder+    , csvBlockBuilder+    , rowBlockBuilder+    , fieldBlockBuilder+    -- ** Conduit+    , rowC+    -- * Row+    , Row+    , ToRow(..)+    -- * Field+    , Field(..)+    , Escaping(..)+    , ToField(..)+    -- ** helpers+    , integral+    , float+    , string+    ) where++import           Basement.Imports -- hiding (throw)+import           Basement.BoxedArray              (Array)+import           Basement.NormalForm              (NormalForm(..))+import           Basement.From                    (Into, into)+import           Basement.String                  (String, replace, any, elem)+import qualified Basement.String        as String (singleton)+import           Basement.Types.Word128           (Word128)+import           Basement.Types.Word256           (Word256)+import           Basement.Types.OffsetSize        (Offset, CountOf)+import           Foundation.Collection.Element    (Element)+import           Foundation.Collection.Collection (Collection, nonEmpty_)+import           Foundation.Collection.Sequential (Sequential(intersperse))+import           Foundation.Collection.Indexed    (IndexedCollection)+import           Foundation.Check.Arbitrary       (Arbitrary(..), frequency)+import           Foundation.Conduit.Internal++import qualified Foundation.String.Builder as String+import           Basement.Block              (Block)+import qualified Basement.Block.Builder    as Block++import           GHC.ST (runST)++-- | CSV field+data Field+    = FieldInteger Integer+    | FieldDouble  Double+    | FieldString  String  Escaping+  deriving (Eq, Show, Typeable)+instance NormalForm Field where+    toNormalForm (FieldInteger i) = toNormalForm i+    toNormalForm (FieldDouble  d) = toNormalForm d+    toNormalForm (FieldString  s e) = toNormalForm s `seq` toNormalForm e+instance Arbitrary Field where+    arbitrary = frequency $ nonEmpty_ [ (1, FieldInteger <$> arbitrary)+                                      , (1, FieldDouble <$> arbitrary)+                                      , (3, string <$> arbitrary)+                                      ]++data Escaping = NoEscape | Escape | DoubleEscape+  deriving (Eq, Ord, Enum, Bounded, Show, Typeable)+instance NormalForm Escaping where+    toNormalForm !_ = ()++class ToField a where+    toField :: a -> Field+instance ToField Field where+    toField = id+instance ToField a => ToField (Maybe a) where+    toField Nothing  = FieldString mempty NoEscape+    toField (Just a) = toField a++instance ToField Int8 where+    toField = FieldInteger . into+instance ToField Int16 where+    toField = FieldInteger . into+instance ToField Int32 where+    toField = FieldInteger . into+instance ToField Int64 where+    toField = FieldInteger . into+instance ToField Int where+    toField = FieldInteger . into++instance ToField Word8 where+    toField = FieldInteger . into+instance ToField Word16 where+    toField = FieldInteger . into+instance ToField Word32 where+    toField = FieldInteger . into+instance ToField Word64 where+    toField = FieldInteger . into+instance ToField Word where+    toField = FieldInteger . into+instance ToField Word128 where+    toField = FieldInteger . into+instance ToField Word256 where+    toField = FieldInteger . into++instance ToField Integer where+    toField = FieldInteger+instance ToField Natural where+    toField = FieldInteger . into++instance ToField Double where+    toField = FieldDouble++instance ToField Char where+    toField = string . String.singleton++instance ToField (Offset a) where+    toField = FieldInteger . into+instance ToField (CountOf a) where+    toField = FieldInteger . into++instance ToField [Char] where+    toField = string . fromString+instance ToField String where+    toField = string++-- | helper function to create a `FieldInteger`+--+integral :: Into Integer a => a -> Field+integral = FieldInteger . into++float :: Double -> Field+float = FieldDouble++-- | heler function to create a FieldString.+--+-- This function will findout automatically if an escaping is needed.+-- if you wish to perform the escaping manually, do not used this function+--+string :: String -> Field+string s = FieldString s encoding+  where+    encoding+        | any g s   = DoubleEscape+        | any f s   = Escape+        | otherwise = NoEscape+    f c = c == '\"'+    g c = c `elem` ",\r\n"++-- | CSV Row+--+newtype Row = Row { unRow :: Array Field }+  deriving (Eq, Show, Typeable, Semigroup, Monoid, Collection, NormalForm, Sequential, IndexedCollection)++type instance Element Row = Field+instance IsList Row where+    type Item Row = Field+    toList = toList . unRow+    fromList = Row . fromList++class ToRow a where+    toRow :: a -> Row+instance ToRow Row where+    toRow = id+instance (ToField a, ToField b) => ToRow (a,b) where+    toRow (a,b) = fromList [toField a, toField b]+instance (ToField a, ToField b, ToField c) => ToRow (a,b,c) where+    toRow (a,b,c) = fromList [toField a, toField b, toField c]+instance (ToField a, ToField b, ToField c, ToField d) => ToRow (a,b,c,d) where+    toRow (a,b,c,d) = fromList [toField a, toField b, toField c, toField d]+instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToRow (a,b,c,d,e) where+    toRow (a,b,c,d,e) = fromList [toField a, toField b, toField c, toField d, toField e]+instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToRow (a,b,c,d,e,f) where+    toRow (a,b,c,d,e,f) = fromList [toField a, toField b, toField c, toField d, toField e, toField f]++-- | CSV Type+newtype CSV = CSV { unCSV :: Array Row }+  deriving (Eq, Show, Typeable, Semigroup, Monoid, Collection, NormalForm, Sequential, IndexedCollection)++type instance Element CSV = Row++instance IsList CSV where+    type Item CSV = Row+    toList = toList . unCSV+    fromList = CSV . fromList++-- | serialise the CSV document into a UTF8 string+csvStringBuilder :: CSV -> String.Builder+csvStringBuilder = String.unsafeStringBuilder . csvBlockBuilder++rowStringBuilder :: Row -> String.Builder+rowStringBuilder = String.unsafeStringBuilder . rowBlockBuilder++fieldStringBuilder :: Field -> String.Builder+fieldStringBuilder = String.unsafeStringBuilder . fieldBlockBuilder++-- | serialise the CSV document into a UTF8 encoded (Block Word8)+csvBlockBuilder :: CSV -> Block.Builder+csvBlockBuilder = mconcat . intersperse (Block.emitString "\r\n") . fmap rowBlockBuilder . toList . unCSV++rowBlockBuilder :: Row -> Block.Builder+rowBlockBuilder = mconcat . intersperse (Block.emitUTF8Char ',') . fmap fieldBlockBuilder . toList . unRow++fieldBlockBuilder :: Field -> Block.Builder+fieldBlockBuilder (FieldInteger i) = Block.emitString $ show i+fieldBlockBuilder (FieldDouble  d) = Block.emitString $ show d+fieldBlockBuilder (FieldString  s e) = case e of+    NoEscape     -> Block.emitString s+    Escape       -> Block.emitUTF8Char '"' <> Block.emitString s <> Block.emitUTF8Char '"'+    DoubleEscape -> Block.emitUTF8Char '"' <> Block.emitString (replace "\"" "\"\"" s) <> Block.emitUTF8Char '"'++rowC :: (ToRow row, Monad m) => Conduit row (Block Word8) m ()+rowC = await >>= go+  where+    go Nothing  = pure ()+    go (Just r) =+      let bytes = runST (Block.run $ rowBlockBuilder (toRow r) <> Block.emitString "\r\n")+         in yield bytes >> await >>= go

@@ -21,6 +21,7 @@     , FNV1a_64     ) where +import           Basement.Block (Block(..)) import           Basement.Compat.Base import qualified Basement.UArray as A import           Basement.Types.OffsetSize@@ -119,8 +120,8 @@     ba :: A.UArray Word8     ba = A.unsafeRecast baA -    goVec :: ByteArray# -> Offset Word8 -> FNV1_32-    goVec !ma !start = loop start initialState+    goVec :: Block Word8 -> Offset Word8 -> FNV1_32+    goVec (Block !ma) !start = loop start initialState       where         !len = start `offsetPlusE` A.length ba         loop !idx !acc@@ -144,8 +145,8 @@     ba :: A.UArray Word8     ba = A.unsafeRecast baA -    goVec :: ByteArray# -> Offset Word8 -> FNV1a_32-    goVec !ma !start = loop start initialState+    goVec :: Block Word8 -> Offset Word8 -> FNV1a_32+    goVec (Block !ma) !start = loop start initialState       where         !len = start `offsetPlusE` A.length ba         loop !idx !acc@@ -169,8 +170,8 @@     ba :: A.UArray Word8     ba = A.unsafeRecast baA -    goVec :: ByteArray# -> Offset Word8 -> FNV1_64-    goVec !ma !start = loop start initialState+    goVec :: Block Word8 -> Offset Word8 -> FNV1_64+    goVec (Block !ma) !start = loop start initialState       where         !len = start `offsetPlusE` A.length ba         loop !idx !acc@@ -194,8 +195,8 @@     ba :: A.UArray Word8     ba = A.unsafeRecast baA -    goVec :: ByteArray# -> Offset Word8 -> FNV1a_64-    goVec !ma !start = loop start initialState+    goVec :: Block Word8 -> Offset Word8 -> FNV1a_64+    goVec (Block !ma) !start = loop start initialState       where         !len = start `offsetPlusE` A.length ba         loop !idx !acc

@@ -24,6 +24,7 @@ import           Basement.Cast (cast) import           Basement.IntegralConv import           Foundation.Hashing.Hasher+import           Basement.Block (Block(..)) import qualified Basement.UArray as A import           Foundation.Array import           Foundation.Numerical@@ -186,8 +187,8 @@     totalLen = A.length array8     array8 = A.unsafeRecast array -    goVec :: ByteArray# -> Offset Word8 -> Sip-    goVec ba start = loop8 initSt initIncr start totalLen+    goVec :: Block Word8 -> Offset Word8 -> Sip+    goVec (Block ba) start = loop8 initSt initIncr start totalLen       where         loop8 !st !incr            _     0 = Sip st incr (currentLen + totalLen)         loop8 !st SipIncremental0 !ofs !l = case l - 8 of

@@ -25,7 +25,6 @@ import qualified Text.Printf as Base import Data.Char (isHexDigit, isDigit) import Numeric (readHex)-import Control.Monad (when)  import Foundation.Class.Storable import Foundation.Hashing.Hashable

@@ -14,7 +14,6 @@ import           Basement.Imports import           Foundation.IO.Terminal import           Foundation.Collection-import           Control.Monad (when)  data MainConfig = MainConfig     { mainHelp       :: Bool

@@ -9,7 +9,6 @@     , uuidParser     ) where -import Control.Monad (unless) import Data.Maybe (fromMaybe)  import           Basement.Compat.Base

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

@@ -7,6 +7,9 @@     , rdFoundationZh     , rdFoundationJap     , rdFoundationHun+    , rdFoundationLower+    , rdFoundationUpper+    , rdSpecialCasing     -- byte array     , rdBytes20     , rdBytes200@@ -26,6 +29,12 @@ rdFoundationEn :: [Char] rdFoundationEn = "Set in the year 0 F.E. (\"Foundation Era\"), The Psychohistorians opens on Trantor, the capital of the 12,000-year-old Galactic Empire. Though the empire appears stable and powerful, it is slowly decaying in ways that parallel the decline of the Western Roman Empire. Hari Seldon, a mathematician and psychologist, has developed psychohistory, a new field of science and psychology that equates all possibilities in large societies to mathematics, allowing for the prediction of future events." +rdFoundationLower :: [Char]+rdFoundationLower = "set in the year 0 f.e. (\"foundation era\"), the psychohistorians opens on trantor, the capital of the 12,000-year-old galactic empire. though the empire appears stable and powerful, it is slowly decaying in ways that parallel the decline of the western roman empire. hari seldon, a mathematician and psychologist, has developed psychohistory, a new field of science and psychology that equates all possibilities in large societies to mathematics, allowing for the prediction of future events."++rdFoundationUpper :: [Char]+rdFoundationUpper = "SET IN THE YEAR 0 F.E. (\"FOUNDATION ERA\"), THE PSYCHOHISTORIANS OPENS ON TRANTOR, THE CAPITAL OF THE 12,000-YEAR-OLD GALACTIC EMPIRE. THOUGH THE EMPIRE APPEARS STABLE AND POWERFUL, IT IS SLOWLY DECAYING IN WAYS THAT PARALLEL THE DECLINE OF THE WESTERN ROMAN EMPIRE. HARI SELDON, A MATHEMATICIAN AND PSYCHOLOGIST, HAS DEVELOPED PSYCHOHISTORY, A NEW FIELD OF SCIENCE AND PSYCHOLOGY THAT EQUATES ALL POSSIBILITIES IN LARGE SOCIETIES TO MATHEMATICS, ALLOWING FOR THE PREDICTION OF FUTURE EVENTS."+ rdFoundationZh :: [Char] rdFoundationZh = "故事發生在〈心理史學家〉五十年後，端點星面臨首度的「謝頓危機」（Seldon Crisis）銀河帝國邊緣的星群紛紛獨立起來，端點星處於四個王國之間，備受威脅。此時，謝頓早前錄下影像突然播放，告知他的後人端點星「銀河百科全書第一號基地」的真正目的──在千年後建立一個新的銀河帝國。同時，在這一千年間，基地會遇到各種不同的危機，令基地可以急速成長。端點星市長塞佛·哈定（Salvor Hardin）趁機發動政變，從心神未定的百科全書理事會手中奪權，以他靈活的手腕帶領端點星走出危機。" @@ -34,6 +43,9 @@  rdFoundationJap :: [Char] rdFoundationJap = "数学者ハリ・セルダンは、膨大な集団の行動を予測する心理歴史学を作りあげ発展させることで、銀河帝国が近いうちに崩壊することを予言する[1]。セルダンは、帝国崩壊後に3万年続くはずの暗黒時代を、あらゆる知識を保存することで千年に縮めようとし、知識の集大成となる銀河百科事典 (Encyclopedia Galactica) を編纂するグループ「ファウンデーション」をつくったが、帝国崩壊を公言し平和を乱したという罪で裁判にかけられ、グループは銀河系辺縁部にある資源の乏しい無人惑星ターミナスへ追放されることになった。しかし、この追放劇すらもセルダンの計画に予定されていた事柄であった。病で死期をさとっていたセルダンは、己の仕事が終わったことを確信する。"++rdSpecialCasing :: [Char]+rdSpecialCasing = "fflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflfflffl"  rdBytes20 ::[Word8] rdBytes20 = take 20 $ cycle [1..255]

@@ -11,6 +11,8 @@     , decimal     , double     , decodeUtf8+    , toLower+    , toUpper     ) where  import Prelude (undefined, Either(..), Char)@@ -27,6 +29,8 @@ reverse     = undefined any         = undefined decodeUtf8  = undefined+toLower     = undefined+toUpper     = undefined  decimal :: Text -> Either a (b, c) decimal = undefined

@@ -43,6 +43,8 @@     , benchFilter     , benchRead     , benchFromUTF8Bytes+    , benchUpper+    , benchLower     ]   where     diffTextString :: (String -> a)@@ -132,6 +134,14 @@     benchFilter = bgroup "Filter" $         fmap (\(n, dat) -> bgroup n $ diffTextString (filter (> 'b')) (Just $ filter (> 'b')) (Text.filter (> 'b')) dat)             allDat++    benchUpper = bgroup "Upper" $+        fmap (\(n, dat) -> bgroup n $ diffTextString upper Nothing Text.toUpper dat)+            (("special casing", rdSpecialCasing) : ("ascii already upper", rdFoundationUpper) : allDat)++    benchLower = bgroup "Lower" $+        fmap (\(n, dat) -> bgroup n $ diffTextString lower Nothing Text.toLower dat)+            (("special casing", rdSpecialCasing) : ("ascii already lower", rdFoundationLower) : allDat)      benchRead = bgroup "Read"         [ bgroup "Integer"

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.19+version:             0.0.20 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -59,10 +59,15 @@   manual:            True  flag doctest-  description:       Add extra friendly boundary check for unsafe array operations+  description:       Build doctest on demand only   default:           False   manual:            True +flag linktest+  description:       Run linking test+  default:           False+  manual:            True+ library   exposed-modules:   Foundation                      Foundation.Numerical@@ -74,6 +79,7 @@                      Foundation.Conduit                      Foundation.Conduit.Textual                      Foundation.Exception+                     Foundation.Format.CSV                      Foundation.String                      Foundation.String.Read                      Foundation.String.Builder@@ -110,7 +116,7 @@                      Foundation.UUID                      Foundation.System.Entropy                      Foundation.System.Bindings-  other-modules:     +  other-modules:                      Foundation.Tuple                      Foundation.Hashing.FNV                      Foundation.Hashing.SipHash@@ -191,7 +197,7 @@                       BangPatterns                       DeriveDataTypeable   build-depends:     base >= 4.7 && < 5-                   , basement == 0.0.6+                   , basement == 0.0.7                    , ghc-prim   -- FIXME add suport for armel mipsel   --  CPP-options: -DARCH_IS_LITTLE_ENDIAN@@ -228,6 +234,8 @@                      Test.Data.List                      Test.Foundation.Network.IPv4                      Test.Foundation.Network.IPv6+                     Test.Foundation.Format+                     Test.Foundation.Format.CSV   default-extensions: NoImplicitPrelude                       RebindableSyntax                       OverloadedStrings@@ -239,6 +247,21 @@   if impl(ghc >= 8.0)     ghc-options:     -Wno-redundant-constraints +test-suite foundation-link+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  default-language:  Haskell2010+  main-is:           Scripts/Link.hs+  default-extensions: NoImplicitPrelude+                      RebindableSyntax+  if flag(linktest)+    build-depends:     base+                     , foundation+                     , template-haskell+    buildable:     True+  else+    buildable:     False+ test-suite doctest   type:              exitcode-stdio-1.0   hs-source-dirs:    tests@@ -273,7 +296,7 @@   if flag(minimal-deps) || impl(ghc < 7.10)     buildable: False   else-    build-depends:     base >= 4, gauge >= 0.2.0, basement, foundation+    build-depends:     base >= 4, gauge, basement, foundation     if flag(bench-all)       cpp-options:     -DBENCH_ALL       build-depends:   text, attoparsec, vector, bytestring

@@ -28,6 +28,7 @@ import Test.Foundation.Network.IPv6 import Test.Foundation.String.Base64 import Test.Checks.Property.Collection+import Test.Foundation.Format import qualified Test.Foundation.Bits as Bits  #if MIN_VERSION_base(4,9,0)@@ -197,11 +198,11 @@     , testNetworkIPv6     , testBase64Refs     , testHexadecimal-    , testTime     , testUUID     , testRandom     , testConduit #if MIN_VERSION_base(4,9,0)     , testBlockN #endif+    , testFormat     ]

@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell   #-}++-- | This module is to test issue+-- https://github.com/haskell-foundation/foundation/issues/326+--+-- this test has been originaly proposed by https://github.com/RyanGlScott+-- in comment of the issue 326:+-- https://github.com/haskell-foundation/foundation/issues/326#issuecomment-309219955++module Main (main) where++import Foundation as F+import Language.Haskell.TH++main :: IO ()+main = $(do runIO $ F.putStrLn (F.fromString "Hello")+            [| return () |])

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Test.Foundation.Format+    ( testFormat+    ) where++import Foundation+import Foundation.Check+import Test.Foundation.Format.CSV+++testFormat :: Test+testFormat = Group "Format"+  [ testFormatCSV+  ]

@@ -0,0 +1,64 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Test.Foundation.Format.CSV+    ( testFormatCSV+    ) where++import Foundation+import Foundation.Format.CSV+import Foundation.Check+import Foundation.String.Builder (toString)++testFormatCSV :: Test+testFormatCSV = Group "CSV"+    [ Group "field unit tests" $ testFieldEncoding <$> fieldUnitTests+    , Group "row unit tests" $ testRowEncoding <$> rowUnitTests+    ]++  where+    testFieldEncoding (f,r) = Property (show f) $+      let str = toString (fieldStringBuilder f)+       in r === str+    testRowEncoding (row,result) = Property (show row) $+      let str = toString (rowStringBuilder row)+       in result === str++fieldUnitTests :: [(Field, String)]+fieldUnitTests =+    [ (FieldInteger 42, "42")+    , (FieldDouble  1, "1.0")+    , (FieldDouble  0.000001, "1.0e-6")+    , (FieldString  "String" NoEscape, "String")+    , (string "String", "String")+    , (string "with comma,string", "\"with comma,string\"")+    , (FieldString  "multiline\nstring" Escape, "\"multiline\nstring\"")+    , (FieldString  "piece of 12\" by 23\""  DoubleEscape, "\"piece of 12\"\" by 23\"\"\"")+    , (string "supported sizes are: 12\", 13\" and 14\"", "\"supported sizes are: 12\"\", 13\"\" and 14\"\"\"")+    ]++rowUnitTests :: [(Row, String)]+rowUnitTests =+    [ (fromList [toField (42 :: Int), toField ("some string" :: String)], "42,some string")+    , (toRow (42 :: Int, "some string" :: String), "42,some string")+    , ( toRow ( 42 :: Int+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              )+      , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\""+      )+    , ( toRow ( 42 :: Int+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              , Just 0.000001 :: Maybe Double+              )+      , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\",1.0e-6"+      )+    , ( toRow ( 42 :: Int+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              , Just 0.000001 :: Maybe Double+              , Nothing       :: Maybe Char+              )+      , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\",1.0e-6,"+      )+    ]

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

@@ -68,7 +68,7 @@          , 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 "ffl should capitalize to FFL" $ validate "ffl" $ upper "fflfflfflfflfflfflfflfflfflffl" == "FFLFFLFFLFFLFFLFFLFFLFFLFFLFFL"          , 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"