foundation 0.0.20 → 0.0.21

raw patch · 23 files changed

+673/−664 lines, 23 filesdep ~basedep ~basementsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, basement

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−286
• Foundation/Format/CSV.hs +16/−194
• Foundation/Format/CSV/Builder.hs +71/−0
• Foundation/Format/CSV/Parser.hs +131/−0
• Foundation/Format/CSV/Types.hs +265/−0
• Foundation/Hashing/FNV.hs +0/−1
• Foundation/Hashing/SipHash.hs +0/−1
• Foundation/Monad/Base.hs +2/−0
• Foundation/Monad/Except.hs +8/−0
• Foundation/Monad/Reader.hs +4/−0
• Foundation/Monad/State.hs +4/−0
• Foundation/Monad/Transformer.hs +0/−1
• Foundation/Network/IPv4.hs +1/−1
• Foundation/Parser.hs +27/−4
• Foundation/Time/Types.hs +4/−0
• README.md +0/−154
• Setup.hs +0/−2
• foundation.cabal +22/−15
• tests/Checks.hs +2/−0
• tests/Test/Basement.hs +13/−0
• tests/Test/Basement/UTF8.hs +17/−0
• tests/Test/Foundation/Bits.hs +18/−1
• tests/Test/Foundation/Format/CSV.hs +68/−4

@@ -1,286 +0,0 @@-## 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-* Improve concat for Block andd UArray-* Add unicode case mapping-* Re-add compatibility with ghc 7.8--## 0.0.18--* Add missing lowlevel Block functionality-* Cleanup UArray to use more functions from Block-* Push Xoroshiro down to basement-* Add instances for foundation's numerical classes for C types-* Update benchmarks to gauge 0.2.0-* Add documentation to some block & uarray functions--## 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--## 0.0.14--Types:--* Add bounded Natural (Zn & Zn64)-* Add Word128 and Word256--Class:--* Add From/Into type class--Collection:--* Add breakEnd, spanEnd, revFindIndex-* Improve arrays sorting-* Add arrays fromListN implementation-* Add arrays convertion primitive--BlockN:--* Cleanup API-* Implement unsnoc--Misc:--* Improve random generation with XorShift-* Improve ghc 8.2 support (warning removals)-* Remove dependency on QuickCheck-* Split lowlevel modules into basement package-* Fix compilation with musl-* Improve native array safety when using through pointer--File:--* remove foldText--## 0.0.13--Block:-* Optimise fold--UArray:-* Re-organise type to be more modular for later change-* Remove the pinned array explicit status in favor of asking-  the runtime system directly on demand.-* Optimise fold operations-* Optimise all&any-* Optimise isPrefixOf-* Optimise isSuffixOf-* Optimise finding byte-* Add an optimise function to break on line (CRLF & LF) as part of a stream--String:-* Optimise length-* Optimise all&any-* Optimise foldr-* Remove many unboxed tuples (next, prev, ..) in favor of a strict unpack-  constructor-* Optimise lines using array breakLine--Collection:-* add stripPrefix & stripSuffix--Tests:-* Improve performance--Misc:-* Cleanup Offset/Size types with the C boundary-* Faster Offset/Size convertions-* Add Base64 support-* Add LE/BE instance for NormalForm-* Add UUID generation and parsing--## 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-* Property report error through with the ASCII, UTF16, UTF32 string decoders-* Fix issue with OSX < Sierra-* Improve Parser and fix backtracking issue-* Strictify UArray to contains a strict ByteArray#-* Improve any & all for most collection types-* Improve minimum & maximum for most collection types-* Add foldl1 & foldr1-* Add takeWhile & dropWhile-* Remove foldl-* Add basic String builder-* Add String replace function-* Add conduit sourceList-* Improve performance of String uncons, unsnoc, filter and fromBytes UTF8 (validate)-* Improve UArray filter-* Fix compilation issue on windows with `clock_gettime` which is not available though all possible compilation mode--## 0.0.10--* Cleanup collection APIs that take a lone Int (length, take, drop, splitAt, ..) to take a CountOf-* Rename Size to CountOf-* Add basic time functions-* Add os dependent timing capability-* Add simple pattern matching for test names with checks.-* add '--list-tests' for checks-* Optimise Eq and Ord for blocks and uarray--## 0.0.9--* Introduce Block & MutableBlock which represent a chunk of memory without slices-  and are faster/leaner in many cases.-* Cleanup String code and some primitives boundaries-* Fix storable alignment tests-* Add These data type (either a, b or both)-* Implement checks command line-* Improve checks terminal output-* drop support for GHC 7.4 and GHC 7.6-* Improve performance of copy out of block and uarray--## 0.0.8--* Add MonadReader and MonadState-* Improve performance of numerical read parsers (integral, double)-* Improve precision of double read parser-* Add Textual conduit combinator (fromBytes, toBytes, lines)-* Add DList-* Fix building on latest Win32, RHEL 5.8-* Add NormalForm-* Export some functions in Internal module to manipulate unboxed mutable array--## 0.0.7--* Improve Checks: random seed, new properties and improved printing-* Add ability to parse Natural, Integer, and Double from String-* Temporarily remove compilation of experimental network resolution introduced in 0.0.5 for windows building.-* Cleanup Offset and Size fixing some bug in String module--## 0.0.6--* Fix build on Centos 6.x / older linux distribution-* Improve test checks generators--## 0.0.5--* Generalize monadic map (mapM, mapM\_)-* HostName type-* Network address / name resolution-* Fix compilation on FreeBSD & OpenBSD-* Initial re-implementation for property tests and tests orchestration-* Fix bug in splitElem, and breakElem-* Improve splitOn to return empty elements-* Fix API bug for snoc and cons in Chunked UArray-* Add UUID-* Check API-* Fix compilation on !x86--## 0.0.4--* Add Conduit for all your streaming needs-* Expose Sequential from Foundation-* Export internal withPtr for optimisation-* Export `ifThenElse`-* Use the proper `String` type for error instead of `[Char]`-* Add `any` and `all` to `Collection`-* Add defaulting to Integer and Double for numerical types-* Add negation for Double and Float (and their associated C types)-* Add/Export system bindings (Posix file/memory handling, Linux Inotify)-* Add Big Endian (BE) / Little Endian (LE) wrapping types-* Add a way to transform an UArray into Hexadecimal/Base16-* Add IPv4 and IPv6 types--## 0.0.3--Monad:--* Add MonadCatch and MonadThrow classes-* Add Transformer base class (MonadTrans)-* Add IdentityT, StateT, ReaderT--Build:--* Fix build on !x86--## 0.0.2--Classes:--* Add `Bifunctor`-* Implement Better storable type class (#111)-* Expose Nthable for GHC >= 7.10 (product type getter)-* Split basic function from `Sequential` to `Collection`-* show return a Foundation `String` now instead of `[Char]`--Numerical:-* Overhaul of numerical classes (`Integral`, `Rational`, `Divisible`, ..)-* add IntegralRounding (i.e. rounding from floating types)-* Expose IEEE manipulation stuff-* Expose all trigonometry functions in `Foundation.Math.Trigonometry`-* Export `Natural` (Unsigned `Integer`)--Collection:-* Add partition-* Add isPrefixOf and isSuffixOf-* Add ArrayBuilder machinery-* Add `String` parser-* Add minimum and maximum to Collection.-* Export Foldable and Collection in Foundation-* add head,last,tail,init--Types:-* Basic `ArrayUArray` support (Array of unboxed Array)-* Add instance for `Float` and `Double` for numerical-* Boxed array: add native slicing in the type-* add `NonEmpty` type-* Add some Data declaration for based type--Hashing:-* Hashing: add FNV, SipHash hash functions family-* Hashable: add support to hash types--Random support:-* Add support for system entropy-* Add pseudo random generation capability using a ChaCha core.--## 0.0.1--* Initial version

@@ -17,216 +17,38 @@       CSV      -- ** Builder-    -- ** String Bulider+    -- *** String Bulider     , csvStringBuilder     , rowStringBuilder     , fieldStringBuilder-    -- ** Block Builder+    -- *** Block Builder     , csvBlockBuilder     , rowBlockBuilder     , fieldBlockBuilder     -- ** Conduit     , rowC++    -- ** Parser+    -- *** String Bulider+    , file+    , record+    , record_+    , field+    -- ** Conduit+    , recordC     -- * Row     , Row-    , ToRow(..)+    , Record(..)     -- * Field     , Field(..)     , Escaping(..)-    , ToField(..)+    , IsField(..)     -- ** 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+import Foundation.Format.CSV.Types+import Foundation.Format.CSV.Builder+import Foundation.Format.CSV.Parser

@@ -0,0 +1,71 @@+-- |+-- Module      : Foundation.Format.CSV.Builder+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+-- Provies the support for Comma Separated Value++{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}++module Foundation.Format.CSV.Builder+    ( -- * String Bulider+      csvStringBuilder+    , rowStringBuilder+    , fieldStringBuilder+      -- * Block Builder+    , csvBlockBuilder+    , rowBlockBuilder+    , fieldBlockBuilder+      -- * Conduit+    , rowC+    ) where++import           Basement.Imports+import           Basement.String                  (replace)+import           Foundation.Collection.Sequential (Sequential(intersperse))+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)++import           Foundation.Format.CSV.Types++-- | 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 :: (Record 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

@@ -0,0 +1,131 @@+-- | CSV parser as specified in RFC4180+--++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Foundation.Format.CSV.Parser+    ( file+    , recordC+    , record+    , record_+    , field+    ) where++import Basement.Imports hiding (throw)+import Foundation.Format.CSV.Types+import Basement.String (snoc)+import Foundation.Parser+import Foundation.Monad+import Foundation.Collection (Collection (elem))+import Foundation.Conduit+import Control.Monad (void)+import Data.Typeable (typeRep)+import Data.Proxy (Proxy(..))++recordC :: (Monad m, MonadThrow m) => Conduit String Row m ()+recordC = awaitForever $ recordC' . parse (record <* optional (elements crlf))+  where+    recordC' (ParseFailed err) = throw err+    recordC' (ParseOk rest v)  = leftover rest *> yield v+    recordC' (ParseMore more)  = do+        mm <- await+        case mm of+            Nothing -> throw (NotEnoughParseOnly :: ParseError String)+            Just b  -> recordC' (more b)++record_ :: forall row . (Typeable row, Record row) => Parser String row+record_ = do+    rs <- record+    case fromRow rs of+        Left err -> reportError $ Expected (show $ typeRep (Proxy @row)) err+        Right v  -> pure v++file :: Parser String CSV+file = do+    mh <- optional $ header <* elements crlf+    x <- record+    xs <- some $ elements crlf *> record+    void $ optional $ elements crlf+    pure $ fromList $ case mh of+        Nothing -> x : xs+        Just h  -> h : x : xs++header :: Parser String Row+header = do+    x <- name+    xs <- some $ element comma *> name+    pure $ fromList $ x : xs++record :: Parser String Row+record = do+    x <- field+    xs <- some $ element comma *> field+    pure $ fromList $ x : xs++name :: Parser String Field+name = field+{-# INLINE name #-}++field :: Parser String Field+field = escaped <|> nonEscaped++escaped :: Parser String Field+escaped = element dquote *> escaped'+  where+    escaped' = do+        x <- takeWhile (dquote /=)+        element dquote+        p <- peek+        if p == (Just dquote)+            then skip 1 >> descaped' (snoc x dquote)+            else pure (FieldString x Escape)+    descaped' acc = do+        x <- takeWhile (dquote /=)+        element dquote+        p <- peek+        if p == (Just dquote)+            then skip 1 >> descaped' (acc <> snoc x dquote)+            else pure (FieldString (acc <> x) DoubleEscape)++nonEscaped :: Parser String Field+nonEscaped = flip FieldString NoEscape <$> takeWhile (not . flip elem specials)+{-# INLINE nonEscaped #-}++comma :: Char+comma = ','+{-# INLINE comma #-}++cr :: Char+cr = '\r'+{-# INLINE cr #-}++dquote :: Char+dquote = '"'+{-# INLINE dquote #-}++lf :: Char+lf = '\n'+{-# INLINE lf #-}++crlf :: String+crlf = fromList [cr, lf]+{-# NOINLINE crlf #-}++{-+textdataQuoted :: String+textdataQuoted = textdata <> specials+{-# NOINLINE textdataQuoted #-}+-}++specials :: String+specials = ",\r\n"+{-# INLINE specials #-}++{-+textdata :: String+textdata = fromList $ [' '..'!'] <> ['#'..'+'] <> ['-'..'~']+{-# NOINLINE textdata #-}+-}

@@ -0,0 +1,265 @@+-- |+-- Module      : Foundation.Format.CSV.Types+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE FlexibleInstances          #-}++module Foundation.Format.CSV.Types+    (-- * CSV+      CSV+    , unCSV++    -- * Row+    , Row+    , unRow+    , Record(..)+    -- * Field+    , Field(..)+    , Escaping(..)+    , IsField(..)+    -- ** helpers+    , integral+    , float+    , string+    ) where++import           Basement.Imports+import           Basement.BoxedArray              (Array, length, unsafeIndex)+import           Basement.NormalForm              (NormalForm(..))+import           Basement.From                    (Into, into)+import           Basement.String                  (String, any, elem, null, uncons)+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)+import           Foundation.Collection.Indexed    (IndexedCollection)+import           Foundation.Check.Arbitrary       (Arbitrary(..), frequency)+import           Foundation.String.Read (readDouble, readInteger)++-- | 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 IsField a where+    toField :: a -> Field+    fromField :: Field -> Either String a+instance IsField Field where+    toField = id+    fromField = pure+instance IsField a => IsField (Maybe a) where+    toField Nothing  = FieldString mempty NoEscape+    toField (Just a) = toField a+    fromField stuff@(FieldString p NoEscape)+        | null p = pure Nothing+        | otherwise = Just <$> fromField stuff+    fromField stuff = Just <$> fromField stuff++fromIntegralField :: Integral b => Field -> Either String b+fromIntegralField (FieldString str NoEscape) = case readInteger str of+    Nothing -> Left "Invalid integral field"+    Just v  -> pure $ fromInteger v+fromIntegralField (FieldInteger v) = pure (fromInteger v)+fromIntegralField _ = Left "Expected integral value"++fromDoubleField :: Field -> Either String Double+fromDoubleField (FieldString str NoEscape) = case readDouble str of+    Nothing -> Left "Invalid double field"+    Just v  -> pure v+fromDoubleField (FieldDouble v) = pure v+fromDoubleField _ = Left "Expected double value"++instance IsField Bool where+    toField = toField . show+    fromField (FieldString "True" NoEscape) = pure True+    fromField (FieldString "False" NoEscape) = pure False+    fromField _ = Left "not a boolean value"+instance IsField Int8 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Int16 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Int32 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Int64 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Int where+    toField = FieldInteger . into+    fromField = fromIntegralField++instance IsField Word8 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word16 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word32 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word64 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word128 where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField Word256 where+    toField = FieldInteger . into+    fromField = fromIntegralField++instance IsField Integer where+    toField = FieldInteger+    fromField = fromIntegralField+instance IsField Natural where+    toField = FieldInteger . into+    fromField = fromIntegralField++instance IsField Double where+    toField = FieldDouble+    fromField = fromDoubleField++instance IsField Char where+    toField = string . String.singleton+    fromField (FieldString str _) = case uncons str of+        Just (c, str') | null str' -> pure c+                       | otherwise -> Left "Expected a char, but received a String"+        Nothing -> Left "Expected a char"+    fromField _ = Left "Expected a char"++instance IsField (Offset a) where+    toField = FieldInteger . into+    fromField = fromIntegralField+instance IsField (CountOf a) where+    toField = FieldInteger . into+    fromField = fromIntegralField++instance IsField [Char] where+    toField = string . fromString+    fromField (FieldString str _) = pure $ toList str+    fromField _ = Left "Expected a Lazy String"+instance IsField String where+    toField = string+    fromField (FieldString str _) = pure str+    fromField _ = Left "Expected a UTF8 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+    g c = c == '\"'+    f 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 Record a where+    toRow :: a -> Row+    fromRow :: Row -> Either String a+instance Record Row where+    toRow = id+    fromRow = pure+instance (IsField a, IsField b) => Record (a,b) where+    toRow (a,b) = fromList [toField a, toField b]+    fromRow (Row row)+        | length row == 2 = (,) <$> fromField (row `unsafeIndex` 0) <*> fromField (row `unsafeIndex` 1)+        | otherwise       = Left (show row)+instance (IsField a, IsField b, IsField c) => Record (a,b,c) where+    toRow (a,b,c) = fromList [toField a, toField b, toField c]+    fromRow (Row row)+        | length row == 3 = (,,) <$> fromField (row `unsafeIndex` 0)+                                 <*> fromField (row `unsafeIndex` 1)+                                 <*> fromField (row `unsafeIndex` 2)+        | otherwise       = Left (show row)+instance (IsField a, IsField b, IsField c, IsField d) => Record (a,b,c,d) where+    toRow (a,b,c,d) = fromList [toField a, toField b, toField c, toField d]+    fromRow (Row row)+        | length row == 4 = (,,,) <$> fromField (row `unsafeIndex` 0)+                                  <*> fromField (row `unsafeIndex` 1)+                                  <*> fromField (row `unsafeIndex` 2)+                                  <*> fromField (row `unsafeIndex` 3)+        | otherwise       = Left (show row)+instance (IsField a, IsField b, IsField c, IsField d, IsField e) => Record (a,b,c,d,e) where+    toRow (a,b,c,d,e) = fromList [toField a, toField b, toField c, toField d, toField e]+    fromRow (Row row)+        | length row == 5 = (,,,,) <$> fromField (row `unsafeIndex` 0)+                                   <*> fromField (row `unsafeIndex` 1)+                                   <*> fromField (row `unsafeIndex` 2)+                                   <*> fromField (row `unsafeIndex` 3)+                                   <*> fromField (row `unsafeIndex` 4)+        | otherwise       = Left (show row)+instance (IsField a, IsField b, IsField c, IsField d, IsField e, IsField f) => Record (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]+    fromRow (Row row)+        | length row == 6 = (,,,,,) <$> fromField (row `unsafeIndex` 0)+                                    <*> fromField (row `unsafeIndex` 1)+                                    <*> fromField (row `unsafeIndex` 2)+                                    <*> fromField (row `unsafeIndex` 3)+                                    <*> fromField (row `unsafeIndex` 4)+                                    <*> fromField (row `unsafeIndex` 5)+        | otherwise       = Left (show row)++-- | 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

@@ -30,7 +30,6 @@ import           Foundation.Numerical import           Foundation.Hashing.Hasher import           Data.Bits-import           GHC.Prim import           GHC.ST  -- | FNV1(a) hash (32 bit variants)

@@ -31,7 +31,6 @@ import           Foundation.Bits import qualified Prelude import           GHC.ST-import           GHC.Prim  -- | SigHash Key data SipKey = SipKey {-# UNPACK #-} !Word64

@@ -7,6 +7,7 @@     , MonadThrow(..)     , MonadCatch(..)     , MonadTrans(..)+    , MonadFix(..)     , IdentityT     ) where @@ -16,3 +17,4 @@ import Foundation.Monad.Exception import Foundation.Monad.Transformer import Foundation.Monad.Identity+import Control.Monad.Fix (MonadFix(..))

@@ -1,5 +1,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE OverloadedStrings #-} module Foundation.Monad.Except     ( ExceptT(..)     ) where@@ -38,6 +39,13 @@             Left e -> return (Left e)             Right x -> runExceptT (k x)     fail = ExceptT . fail++instance (AMPMonad m, MonadFix m) => MonadFix (ExceptT e m) where+    mfix f = ExceptT (mfix (runExceptT . f . fromEither))+      where+        fromEither (Right x) = x+        fromEither (Left  _) = error "mfix (ExceptT): inner computation returned Left value"+    {-# INLINE mfix #-}  instance MonadReader m => MonadReader (ExceptT e m) where     type ReaderContext (ExceptT e m) = ReaderContext m

@@ -40,6 +40,10 @@     ma >>= mab = ReaderT $ \r -> runReaderT ma r >>= \a -> runReaderT (mab a) r     {-# INLINE (>>=) #-} +instance (AMPMonad m, MonadFix m) => MonadFix (ReaderT s m) where+    mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r+    {-# INLINE mfix #-}+ instance MonadTrans (ReaderT r) where     lift f = ReaderT $ const f     {-# INLINE lift #-}

@@ -47,6 +47,10 @@     ma >>= mab = StateT $ runStateT ma >=> (\(a, s2) -> runStateT (mab a) s2)     {-# INLINE (>>=) #-} +instance (Functor m, MonadFix m) => MonadFix (StateT s m) where+    mfix f = StateT $ \s -> mfix $ \ ~(a, _) -> runStateT (f a) s+    {-# INLINE mfix #-}+ instance MonadTrans (StateT s) where     lift f = StateT $ \s -> f >>= return . (,s)     {-# INLINE lift #-}

@@ -3,7 +3,6 @@     ( MonadTrans(..)     ) where -import Basement.Compat.Base import Basement.Compat.AMP  -- | Basic Transformer class

@@ -29,7 +29,7 @@ import Foundation.String (String) import Foundation.Primitive import Foundation.Bits-import Foundation.Parser+import Foundation.Parser hiding (peek) import Foundation.Collection (Sequential, Element, elem)  -- | IPv4 data type

@@ -23,6 +23,7 @@  {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}  module Foundation.Parser     ( Parser@@ -38,7 +39,8 @@       ParserSource(..)      , -- * combinator-      element+      peek+    , element     , anyElement     , elements     , string@@ -85,9 +87,9 @@     | Satisfy (Maybe String)         -- ^ the @satisfy@ or @satisfy_@ function failed,   deriving (Typeable)-instance Typeable input => Exception (ParseError input)+instance (Typeable input, Show input) => Exception (ParseError input) -instance Show (ParseError input) where+instance Show input => Show (ParseError input) where     show (NotEnough (CountOf sz)) = "NotEnough: missing " <> show sz <> " element(s)"     show NotEnoughParseOnly    = "NotEnough, parse only"     show (ExpectedElement _ _) = "Expected _ but received _"@@ -95,6 +97,14 @@     show (Satisfy Nothing)     = "Satisfy"     show (Satisfy (Just s))    = "Satisfy: " <> toList s +instance {-# OVERLAPPING #-} Show (ParseError String) where+    show (NotEnough (CountOf sz)) = "NotEnough: missing " <> show sz <> " element(s)"+    show NotEnoughParseOnly    = "NotEnough, parse only"+    show (ExpectedElement a b) = "Expected "<>show a<>" but received " <> show b+    show (Expected a b)        = "Expected "<>show a<>" but received " <> show b+    show (Satisfy Nothing)     = "Satisfy"+    show (Satisfy (Just s))    = "Satisfy: " <> toList s+ -- Results --------------------------------------------------------------------  -- | result of executing the `parser` over the given `input`@@ -107,7 +117,7 @@         -- ^ the parser needs more input, pass an empty @Chunk@ or @mempty@         -- to tell the parser you don't have anymore inputs. -instance Show k => Show (Result input k) where+instance (Show k, Show input) => Show (Result input k) where     show (ParseFailed err) = "Parser failed: " <> show err     show (ParseOk _ k) = "Parser succeed: " <> show k     show (ParseMore _) = "Parser incomplete: need more"@@ -300,6 +310,19 @@         Nothing -> err buf off        nm $ NotEnough 1         Just x  -> ok  buf (succ off) nm x {-# INLINE anyElement #-}++-- | peek the first element from the input source without consuming it+--+-- Returns 'Nothing' if there is no more input to parse.+--+peek :: ParserSource input => Parser input (Maybe (Element input))+peek = Parser $ \buf off nm err ok ->+    case buf ! off of+        Nothing -> runParser_ peekOnly buf off nm err ok+        Just x  -> ok buf off nm (Just x)+  where+    peekOnly = Parser $ \buf off nm _ ok ->+        ok buf off nm (buf ! off)  element :: ( ParserSource input            , Eq (Element input)

@@ -5,6 +5,7 @@ -- -- An implementation of a timing framework --+{-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Foundation.Time.Types     ( NanoSeconds(..)@@ -21,7 +22,9 @@ newtype NanoSeconds = NanoSeconds Word64     deriving (Show,Eq,Ord,Additive,Enum,Bounded) + instance PrimType NanoSeconds where+    type PrimSize NanoSeconds = 8     primSizeInBytes _        = primSizeInBytes (Proxy :: Proxy Word64)     primShiftToBytes _       = primShiftToBytes (Proxy :: Proxy Word64)     primBaUIndex ba ofs      = primBaUIndex ba (coerce ofs)@@ -36,6 +39,7 @@     deriving (Show,Eq,Ord,Additive,Enum,Bounded)  instance PrimType Seconds where+    type PrimSize Seconds    = 8     primSizeInBytes _        = primSizeInBytes (Proxy :: Proxy Word64)     primShiftToBytes _       = primShiftToBytes (Proxy :: Proxy Word64)     primBaUIndex ba ofs      = primBaUIndex ba (coerce ofs)

@@ -1,154 +0,0 @@-Foundation-==========--[![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/)-[![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)--Documentation:--* [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)--Discuss:--* [FP Chat](https://fpchat-invite.herokuapp.com) `#haskell-foundation` channel-* [Gitter](https://gitter.im/haskell-foundation/foundation)--Goals-=====--* provide a base like set of modules that provide a consistent set of features and bugfixes across multiple versions of GHC (unlike base).-* provide a better and more efficient prelude than base's prelude.-* be self-sufficient: no external dependencies apart from base (or ghc packages).-* provide better data-types: packed unicode string by default, arrays.-* Better numerical classes that better represent mathematical things (No more all-in-one Num).--Usage-=====--How to use with the normal Prelude-------------------------------------Add the `foundation` package in your cabal file, and it's recommended to import Foundation qualified if-you're planning to use with the normal Prelude:--For example:--```haskell-import qualified Foundation as F-```--It's also recommended if you're going to deal with packages using text, bytestring, vector.. to use-the `foundation-edge` package.--How to use fully without Prelude-----------------------------------Disable the built-in prelude at the top of your file:--```haskell-{-# LANGUAGE NoImplicitPrelude #-}-```--Or directly in your project cabal file:--```haskell-Default-Extensions: NoImplicitPrelude-```--Then in your modules:--```haskell-import Foundation-```--Advanced settings-------------------------Please check out the chapter [Advanced Usage Options](docs/advanced-runtime.md) in the-documentation.---How to contribute-=================--Contribution guide can be found-[here](http://haskell-foundation.readthedocs.io/en/latest/contributing/).---Profiling------------If you want to see the core (simpl step) or the assembly (asm step), then you can build with--    stack build --ghc-options -ddump-simpl --ghc-options -ddump-asm--Note that it doesn't actually will create the necessary extra files if the modules doesn't need building.--you can then find your build by-products in:--    .stack-work/dist/<architecture>/Cabal-<CabalVersion>/build/--Each modules that get compiled will create an equivalent file in the build directory:--* ModuleName.dump-simpl-* ModuleName.dump-asm--For profiling individual programs, the following command is useful:--    stack ghc -- -O --make X.hs -prof -auto-all -caf-all -fforce-recomp--Benchmarking---------------To get the list of benchmark:--    stack bench --benchmark-arguments -l--To compare against other libraries, you need to set the `bench-all` flag--    stack bench --flag foundation:bench-all --benchmark-arguments -l--To run a specific or set of benchmarks :--    stack bench --flag foundation:bench-all --benchmark-arguments 'types/String/SplitAt/mascii-10/Text'-    stack bench --flag foundation:bench-all --benchmark-arguments '-m prefix types/String/SplitAt'-    stack bench --flag foundation:bench-all --benchmark-arguments '-m glob types/String/SplitAt'--To register a set of benchmarks:--    stack bench --flag foundation:bench-all --benchmark-arguments "--csv $(git describe).csv"---Design-======--Foundation started on the simple idea of trying to put everything I need in one-simple and consistent package. The amazing haskell ecosystem is extremely-fragmented and maintained by different people with different goals, free time,-and style. The overall scare of not trying to change anything relatively-central (`base`, `bytestring`, `text`, `vector`, ...) for a promise of stability-has pushed many people to work on their own thing, leading to unnecessary work-duplication and further fragmentation.---Foundation uses and abuses type families.---Code Organisation-=================--Every foundation modules start by `Foundation`.--* `Foundation` is the prelude replacement module.-* `Basement.Compat` contains only compatibilty and re-export from ghc/ghc-prim/base.-* `Foundation.Primitive` is where all the lowlevel magic happens:-  * Important types that underpins many others part-  * Pervasive features

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.20+version:             0.0.21 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -29,14 +29,12 @@ homepage:            https://github.com/haskell-foundation/foundation bug-reports:         https://github.com/haskell-foundation/foundation/issues cabal-version:       >=1.18-tested-with:         GHC==8.2.1, GHC==8.0.2, GHC==7.10.3 extra-source-files:  cbits/*.h-extra-doc-files:     README.md-                     CHANGELOG.md  source-repository head   type: git   location: https://github.com/haskell-foundation/foundation+  subdir: foundation  flag experimental   description:       Enable building experimental features, known as highly unstable or without good support cross-platform@@ -96,6 +94,7 @@                      Foundation.Collection                      Foundation.Primitive                      Foundation.List.DList+                     Foundation.List.ListN                      Foundation.Monad                      Foundation.Monad.Except                      Foundation.Monad.Reader@@ -113,6 +112,7 @@                      Foundation.Time.Types                      Foundation.Time.Bindings                      Foundation.Time.StopWatch+                     Foundation.Tuple.Nth                      Foundation.UUID                      Foundation.System.Entropy                      Foundation.System.Bindings@@ -142,6 +142,9 @@                      Foundation.Collection.Zippable                      Foundation.Collection.Mappable                      Foundation.Conduit.Internal+                     Foundation.Format.CSV.Types+                     Foundation.Format.CSV.Builder+                     Foundation.Format.CSV.Parser                      Foundation.Numerical.Floating                      Foundation.IO.File                      Foundation.Monad.MonadIO@@ -187,18 +190,22 @@   if os(osx)     exposed-modules: Foundation.System.Bindings.Macos -  if impl(ghc >= 7.10)-    exposed-modules: Foundation.Tuple.Nth-                     Foundation.List.ListN-   default-extensions: NoImplicitPrelude                       RebindableSyntax                       TypeFamilies                       BangPatterns                       DeriveDataTypeable-  build-depends:     base >= 4.7 && < 5-                   , basement == 0.0.7++  if impl(ghc < 8.0)+    buildable: False+  else+    build-depends:   base                    , ghc-prim+    if os(windows)+      build-depends: Win32++  build-depends: basement == 0.0.8+   -- FIXME add suport for armel mipsel   --  CPP-options: -DARCH_IS_LITTLE_ENDIAN   -- FIXME add support for powerpc powerpc64 armeb mipseb@@ -207,8 +214,6 @@     cpp-options: -DARCH_IS_LITTLE_ENDIAN   else     cpp-options: -DARCH_IS_UNKNOWN_ENDIAN-  if os(windows)-    build-depends:    Win32   ghc-options:       -Wall -fwarn-tabs   default-language:  Haskell2010   if impl(ghc >= 8.0)@@ -230,6 +235,8 @@                      Test.Foundation.String.Base64                      Test.Foundation.String                      Test.Foundation.Bits+                     Test.Basement+                     Test.Basement.UTF8                      Test.Data.Network                      Test.Data.List                      Test.Foundation.Network.IPv4@@ -239,7 +246,7 @@   default-extensions: NoImplicitPrelude                       RebindableSyntax                       OverloadedStrings-  build-depends:     base >= 3 && < 5+  build-depends:     base                    , basement                    , foundation   ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures@@ -274,7 +281,7 @@     buildable:       False   else     if flag(doctest)-      build-depends:     base >= 3 && < 5+      build-depends:     base                        , doctest >= 0.9       buildable:     True     else@@ -296,7 +303,7 @@   if flag(minimal-deps) || impl(ghc < 7.10)     buildable: False   else-    build-depends:     base >= 4, gauge, basement, foundation+    build-depends:     base, gauge, basement, foundation     if flag(bench-all)       cpp-options:     -DBENCH_ALL       build-depends:   text, attoparsec, vector, bytestring

@@ -30,6 +30,7 @@ import Test.Checks.Property.Collection import Test.Foundation.Format import qualified Test.Foundation.Bits as Bits+import qualified Test.Basement as Basement  #if MIN_VERSION_base(4,9,0) import Test.Foundation.Primitive.BlockN@@ -110,6 +111,7 @@             ]         , Group "Number" testNumberRefs         ]+    , Basement.tests     , Bits.tests     , Group "String"         [ Group "reading"

@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+module Test.Basement+    ( tests+    ) where++import Foundation+import Foundation.Check+import qualified Test.Basement.UTF8 as UTF8++tests = Group "basement"+    [ UTF8.tests+    ]

@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE OverloadedStrings   #-}+module Test.Basement.UTF8+    ( tests )+    where++import Basement.Types.CharUTF8+import Foundation+import Foundation.Check+import Foundation.String++tests = Group "utf8"+    [ Property "CharUTF8" $ \c -> decodeCharUTF8 (encodeCharUTF8 c) === c+    ]

@@ -1,10 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} module Test.Foundation.Bits     ( tests     ) where +import Basement.Cast import Foundation.Bits import Foundation.Check import Foundation@@ -16,7 +18,7 @@     arbitrary = Shifter . applyMod <$> arbitrary       where applyMod i = abs i `mod` 256 -testBits :: forall a . (Integral a, IsIntegral a, Bits a, Show a, Eq a, Arbitrary a, Typeable a)+testBits :: forall a . (Additive a, Bounded a, Difference a ~ a, Integral a, IsIntegral a, Bits a, Show a, Subtractive a, Eq a, Arbitrary a, Typeable a)          => String          -> Proxy a          -> Gen a@@ -26,6 +28,21 @@         (a `shiftR` i) === convertBack (toInteger a `shiftR` i)     , Property "shiftL" $ \(a :: a) (Shifter i) ->         (a `shiftL` i) === convertBack (toInteger a `shiftL` i)+    , Property "maxBound value" $ \(a :: a) ->+        case bitSizeMaybe a of+          Just bs ->+            let actualMaxBound :: a+                actualMaxBound = maxBound+                expectedMaxBound :: Integer+                expectedMaxBound = 2^(cast bs :: Word) - (1 :: Integer)+            in toInteger actualMaxBound === expectedMaxBound+          Nothing -> propertyFail "Expected FiniteBits"+    , Property "complement maxBound" $+        complement 0 === (maxBound :: a)+    , Property "overflow maxBound" $+        maxBound + 1 === (0 :: a)+    , Property "underflow zero" $+        (0 :: a) - 1 === maxBound     ]   where     convertBack x

@@ -1,5 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+ module Test.Foundation.Format.CSV     ( testFormatCSV     ) where@@ -8,18 +11,42 @@ import Foundation.Format.CSV import Foundation.Check import Foundation.String.Builder (toString)+import Foundation.Parser (parseOnly) +import Data.Typeable+ testFormatCSV :: Test testFormatCSV = Group "CSV"     [ Group "field unit tests" $ testFieldEncoding <$> fieldUnitTests     , Group "row unit tests" $ testRowEncoding <$> rowUnitTests+    , Group "row unit tests" $ testRowDecoding <$> rowUnitTests+    , Group "record . toRow == id"+        [ pTest (Proxy @(Bool, Bool))+        , pTest (Proxy @(Int8, Word32, Natural))+        , pTest (Proxy @(Int, String, Word256, Word128))+        , pTest (Proxy @(Word8, String, Bool, Int64, String))+        ]     ]    where+    pTest :: (Arbitrary a, Record a, Typeable a, Show a, Eq a) => Proxy a -> Test+    pTest p = Property (show $ typeRep p) (go p)+      where+        go :: (Arbitrary a, Record a, Typeable a, Show a, Eq a) => Proxy a -> a -> PropertyCheck+        go _ t =+          let row = (toRow t)+              str = toString $ rowStringBuilder row+           in case parseOnly record_ str of+               Left err -> propertyFail $ show err+               Right v -> t === v     testFieldEncoding (f,r) = Property (show f) $       let str = toString (fieldStringBuilder f)        in r === str-    testRowEncoding (row,result) = Property (show row) $+    testRowDecoding (r, row,result) = Property (show r) $+        case parseOnly record result of+            Left err -> propertyFail (show err)+            Right v  -> row === v+    testRowEncoding (row, _,result) = Property (show row) $       let str = toString (rowStringBuilder row)        in result === str @@ -36,14 +63,24 @@     , (string "supported sizes are: 12\", 13\" and 14\"", "\"supported sizes are: 12\"\", 13\"\" and 14\"\"\"")     ] -rowUnitTests :: [(Row, String)]+rowUnitTests :: [(Row, Row, String)] rowUnitTests =-    [ (fromList [toField (42 :: Int), toField ("some string" :: String)], "42,some string")-    , (toRow (42 :: Int, "some string" :: String), "42,some string")+    [ ( fromList [toField (42 :: Int), toField ("some string" :: String)]+      , fromList [toField ("42" :: String), toField ("some string" :: String)]+      , "42,some string"+      )+    , ( toRow (42 :: Int, "some string" :: String)+      , toRow ("42" :: String, "some string" :: String)+      , "42,some string"+      )     , ( toRow ( 42 :: Int               , "some string" :: String               , "supported sizes are: 12\", 13\" and 14\"" :: String               )+      , toRow ( "42" :: String+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              )       , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\""       )     , ( toRow ( 42 :: Int@@ -51,6 +88,11 @@               , "supported sizes are: 12\", 13\" and 14\"" :: String               , Just 0.000001 :: Maybe Double               )+      , toRow ( "42" :: String+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              , Just "1.0e-6" :: Maybe String+              )       , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\",1.0e-6"       )     , ( toRow ( 42 :: Int@@ -59,6 +101,28 @@               , Just 0.000001 :: Maybe Double               , Nothing       :: Maybe Char               )+      , toRow ( "42" :: String+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              , Just "1.0e-6"      :: Maybe String+              , Nothing       :: Maybe String+              )       , "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+              , "with £ € ¥" :: String+              )+      , toRow ( "42" :: String+              , "some string" :: String+              , "supported sizes are: 12\", 13\" and 14\"" :: String+              , Just "1.0e-6"      :: Maybe String+              , Nothing       :: Maybe String+              , "with £ € ¥" :: String+              )+      , "42,some string,\"supported sizes are: 12\"\", 13\"\" and 14\"\"\",1.0e-6,,with £ € ¥"       )     ]