Frames 0.6.0 → 0.6.1

raw patch · 8 files changed

+154/−84 lines, 8 filesdep ~vinylPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: vinyl

API changes (from Hackage documentation)

Files

• Frames.cabal +6/−6
• demo/Main.hs +0/−73
• demo/framestack/app/Main.hs +51/−0
• src/Frames/ColumnTypeable.hs +14/−2
• src/Frames/ColumnUniverse.hs +2/−0
• src/Frames/InCore.hs +38/−1
• test/Chunks.hs +23/−0
• test/Spec.hs +20/−2

@@ -1,5 +1,5 @@ name:                Frames-version:             0.6.0+version:             0.6.1 synopsis:            Data frames For working with tabular data files description:         User-friendly, type safe, runtime efficient tooling for                      working with tabular data deserialized from@@ -15,7 +15,7 @@ category:            Data build-type:          Simple extra-source-files:  benchmarks/*.hs benchmarks/*.py-                     demo/Main.hs CHANGELOG.md README.md+                     demo/framestack/app/Main.hs CHANGELOG.md README.md                      data/GetData.hs                      test/examples.toml                      test/data/managers.csv test/data/employees.csv@@ -29,7 +29,7 @@                      data/left1.csv data/right1.csv data/left_summary.csv                      data/FL2.csv cabal-version:       >=1.10-tested-with:         GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1+tested-with:         GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3  source-repository head   type:     git@@ -76,7 +76,7 @@                        pipes-parse >= 3.0 && < 3.1,                        pipes-safe >= 2.2.6 && < 2.4,                        bytestring,-                       vinyl >= 0.10.0 && < 0.11,+                       vinyl >= 0.10.0 && < 0.12,                        discrimination,                        contravariant,                        hashable,@@ -142,7 +142,7 @@     build-depends: base, list-t, microlens, transformers, Frames,                    vector, text, template-haskell, ghc-prim, readable,                    pipes-  hs-source-dirs: demo+  hs-source-dirs: demo/framestack/app   default-language: Haskell2010   ghc-options: -O2   -- ghc-options: -O2 -fllvm@@ -218,7 +218,7 @@   main-is:             Spec.hs   other-modules:       DataCSV PrettyTH Temp LatinTest Issue114 NoHeader                        UncurryFold UncurryFoldNoHeader UncurryFoldPartialData-                       Categorical+                       Categorical Chunks   build-depends:       base, text, hspec, Frames, template-haskell,                        temporary, directory, htoml, regex-applicative, pretty,                        unordered-containers, pipes, HUnit, vinyl,

@@ -1,73 +0,0 @@-{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-}-{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-}-module Main where-import Data.Functor.Identity-import Frames-import Lens.Micro-import qualified Pipes as P-import qualified Pipes.Prelude as P--tableTypes "Row" "data/data1.csv"--tbl :: IO [Row]-tbl = runSafeT . P.toListM $ readTable "data/data1.csv"--ageDoubler :: (Age ∈ rs) => Record rs -> Record rs-ageDoubler = age %~ (* 2)--tbl2 :: IO [Row]-tbl2 = runSafeT . P.toListM $ readTable "data/data2.csv"--tbl2a :: IO [ColFun Maybe Row]-tbl2a = runSafeT . P.toListM $ readTableMaybe "data/data2.csv"--{---REPL examples:--λ> tbl >>= mapM_ print-{name :-> "joe", age :-> 21}-{name :-> "sue", age :-> 23}-{name :-> "bob", age :-> 44}-{name :-> "laura", age :-> 18}--λ> tbl2 >>= mapM_ print-{name :-> "joe", age :-> 21}-{name :-> "sue", age :-> 23}-{name :-> "laura", age :-> 18}--λ> tbl2a >>= mapM_ (putStrLn . showRecF)-{Just (name :-> "joe"), Just (age :-> 21)}-{Just (name :-> "sue"), Just (age :-> 23)}-{Just (name :-> "bob"), Nothing}-{Just (name :-> "laura"), Just (age :-> 18)}---}---- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/--- Note: We have to replace carriage returns (\r) with line feed--- characters (\n) for the text library's line parsing to work.-tableTypes "Ins" "data/FL2.csv"--insuranceTbl :: MonadSafe m => P.Producer Ins m ()-insuranceTbl = readTable "data/FL2.csv"--insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m ()-insMaybe = readTableMaybe "data/FL2.csv"--type TinyIns = Record [PolicyID, PointLatitude, PointLongitude]--main :: IO ()-main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast)-            :: IO (P.Producer TinyIns Identity ())-          putStrLn "In-core representation prepared"-          let Identity (n,sumLat) =-                P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r))-                       (0::Int,0)-                       id-                       itbl-          putStrLn $ "Considering " ++ show n ++ " records..."-          putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n)-          let Identity sumLong =-                P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl-          putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n)

@@ -0,0 +1,51 @@+{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-}+module Main where+import Data.Functor.Identity+import Frames+import Lens.Micro+import qualified Pipes as P+import qualified Pipes.Prelude as P++tableTypes "Row" "../../data/data1.csv"++tbl :: IO [Row]+tbl = runSafeT . P.toListM $ readTable "../../data/data1.csv"+++ageDoubler :: (Age ∈ rs) => Record rs -> Record rs+ageDoubler = age %~ (* 2)++tbl2 :: IO [Row]+tbl2 = runSafeT . P.toListM $ readTable "../../data/data2.csv"++tbl2a :: IO [ColFun Maybe Row]+tbl2a = runSafeT . P.toListM $ readTableMaybe "../../data/data2.csv"++-- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/+-- Note: We have to replace carriage returns (\r) with line feed+-- characters (\n) for the text library's line parsing to work.+tableTypes "Ins" "../../data/FL2.csv"++insuranceTbl :: MonadSafe m => P.Producer Ins m ()+insuranceTbl = readTable "../../data/FL2.csv"++insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m ()+insMaybe = readTableMaybe "../../data/FL2.csv"++type TinyIns = Record [PolicyID, PointLatitude, PointLongitude]++main :: IO ()+main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast)+            :: IO (P.Producer TinyIns Identity ())+          putStrLn "In-core representation prepared"+          let Identity (n,sumLat) =+                P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r))+                       (0::Int,0)+                       id+                       itbl+          putStrLn $ "Considering " ++ show n ++ " records..."+          putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n)+          let Identity sumLong =+                P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl+          putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n)

@@ -6,6 +6,7 @@ import Data.Readable (Readable(fromText)) import Data.Typeable (Proxy(..), typeRep, Typeable) import qualified Data.Text as T+import Data.Int (Int32, Int64) import Data.Vinyl.Functor (Const(..)) import Language.Haskell.TH @@ -58,10 +59,21 @@ parse' :: (MonadPlus m, Parseable a) => T.Text -> m a parse' = fmap discardConfidence . parse +parseIntish :: (Readable a, MonadPlus f) => T.Text -> f (Parsed a)+parseIntish t =+  Definitely <$> fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t))+ instance Parseable Bool where+ instance Parseable Int where-  parse t = Definitely <$>-            fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t))+  parse = parseIntish+instance Parseable Int32 where+  parse = parseIntish+instance Parseable Int64 where+  parse = parseIntish+instance Parseable Integer where+  parse = parseIntish+ instance Parseable Float where instance Parseable Double where   -- Some CSV's export Doubles in a format like '1,000.00', filtering

@@ -156,9 +156,11 @@   inferType = bestRep   {-# INLINABLE inferType #-} +#if !MIN_VERSION_vinyl(0,11,0) instance forall ts. (RPureConstrained Show ts, RecApplicative ts)   => Show (CoRec ColInfo ts) where   show x = "(Col " ++ onCoRec @Show show x ++")"+#endif    -- * Common Columns 

@@ -149,7 +149,8 @@ -- which provides an easier-to-use function that indexes into the -- table in a row-major fashion. inCoreSoA :: forall m rs. (PrimMonad m, RecVec rs)-          => P.Producer (Record rs) m () -> m (Int, V.Rec (((->) Int) :. ElField) rs)+          => P.Producer (Record rs) m ()+          -> m (Int, V.Rec (((->) Int) :. ElField) rs) inCoreSoA xs =   do mvs <- allocRec (Proxy :: Proxy rs) initialCapacity      let feed (!i, !sz, !mvs') row@@ -220,3 +221,39 @@ filterFrame :: RecVec rs => (Record rs -> Bool) -> FrameRec rs -> FrameRec rs filterFrame p f = runST $ inCoreAoS $ P.each f P.>-> P.filter p {-# INLINE filterFrame #-}++-- | Process a stream of 'Record's into a stream of 'Frame's that each+-- contains no more than the given number of records.+produceFrameChunks :: forall rs m. (RecVec rs, PrimMonad m)+                   => Int+                   -> P.Producer (Record rs) m ()+                   -> P.Producer (FrameRec rs) m ()+produceFrameChunks chunkSize = go+  where go src = do mutVecs <- P.lift (allocRec (Proxy :: Proxy rs) chunkSize)+                    goChunk src mutVecs 0+        goChunk src mutVecs !i+          | i >= chunkSize =+              do chunk <- P.lift (freezeFrame i mutVecs)+                 P.yield chunk+                 go src+          | otherwise =+            do maybeRow <- P.lift (P.next src)+               case maybeRow of+                 Left _ -> do+                   P.lift (freezeFrame i mutVecs) >>= P.yield+                 Right (r,src') -> do+                   P.lift (writeRec (Proxy::Proxy rs) i mutVecs r)+                   goChunk src' mutVecs (i+1)+        freezeFrame :: Int -> Record (VectorMs m rs) -> m (FrameRec rs)+        freezeFrame n =+          fmap (toAoS n . produceRec (Proxy::Proxy rs))+          . freezeRec (Proxy::Proxy rs) n+{-# INLINABLE produceFrameChunks #-}++-- | Split a 'Frame' into chunks of no more than the given number of+-- records. The underlying memory is shared with the original 'Frame'.+frameChunks :: Int -> FrameRec rs -> [FrameRec rs]+frameChunks chunkSize whole = map aux [ 0, chunkSize .. frameLength whole - 1 ]+  where aux i = Frame (min (frameLength whole - i) chunkSize)+                      (frameRow whole . (+ i))+{-# INLINABLE frameChunks #-}

@@ -0,0 +1,23 @@+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes,+             TemplateHaskell, TypeApplications #-}+module Chunks where+import Frames+import Frames.InCore (frameChunks, produceFrameChunks)+import Pipes ((>->))+import qualified Pipes.Prelude as P++tableTypes "Row" "test/data/prestige.csv"++getEducation :: Row -> Double+getEducation = rgetField @Education++chunkInCore :: IO [Double]+chunkInCore = do+  rows <- inCoreAoS (readTable "test/data/prestige.csv")+  let chunks = frameChunks 10 rows+  return $ map (getEducation . flip frameRow 0) chunks++chunkStream :: IO [Double]+chunkStream = runSafeT . P.toListM $+   produceFrameChunks 10 (readTable "test/data/prestige.csv")+   >-> P.map (getEducation . flip frameRow 0)

@@ -7,7 +7,7 @@ import Data.Functor.Identity import Data.Char import qualified Data.Foldable as F-import Data.List (find)+import Data.List (find, isPrefixOf) import Data.Monoid (First(..)) import qualified Data.Text as T import Language.Haskell.TH as TH@@ -15,6 +15,7 @@ import Frames import Frames.CSV (produceCSV) import Frames.CSV (defaultParser, produceTokens, defaultSep, readColHeaders)+import qualified Chunks import DataCSV import Pipes.Prelude (toListM) import PrettyTH@@ -81,7 +82,16 @@ newtype Code = Code String instance Show Code where show (Code x) = x instance Eq Code where-  Code a == Code b = filter (not . isSpace) a == filter (not . isSpace) b+  Code a == Code b = clean a == clean b+    where clean = go (removePrefix moduleNames) . filter (not . isSpace)+          go _ [] = []+          go f s@(c:cs) = case removePrefix moduleNames s of+                            Nothing -> c : go f cs+                            Just n -> go f (drop n s)+          moduleNames = [ "GHC.Maybe." ]+          removePrefix [] _ = Nothing+          removePrefix (w:ws) s | w `isPrefixOf` s = Just (length w)+                                | otherwise = removePrefix ws s  shouldBeWithinEpsilon :: Double -> Double -> Expectation shouldBeWithinEpsilon actual expected =@@ -201,3 +211,11 @@              return False)             `catch` \(_ :: ErrorCall) -> return True          it "Fails on embedded newlines" caught+       describe "Chunking" $ do+         let everyTenthEducation = [13.11,12.39,15.97,12.79,12.09,11.13,8.5,7.64,8.78,6.92,10.0]+         inCoreChunks <- H.runIO Chunks.chunkInCore+         it "Can split in-memory data into chunks" $+           inCoreChunks `shouldBe` everyTenthEducation+         streamedChunks <- H.runIO Chunks.chunkStream+         it "Can split an input stream into Frame chunks" $+           streamedChunks `shouldBe` everyTenthEducation