csv-table 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+131/−83 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• csv-table.cabal +1/−1
• src/Data/CSV/Table/Email.hs +11/−14
• src/Data/CSV/Table/Ops.hs +88/−47
• src/Data/CSV/Table/Types.hs +31/−21

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                csv-table-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Scripts for manipulating tables stored as CSV files description:         Scripts for manipulating tables, e.g. filter, join, etc. stored as CSV files homepage:            https://github.com/ucsd-progsys/csv-table

@@ -1,9 +1,9 @@-module Data.CSV.Table.Email -  ( -- * Email representation +module Data.CSV.Table.Email+  ( -- * Email representation     Email (..)-    +     -- * Send function-    , sendMail +    , sendMail     ) where @@ -15,32 +15,29 @@ import Data.CSV.Table.Ops  -data Email   = E { uid     :: String +data Email   = E { uid     :: String                  , to      :: String                  , cc      :: [String]                  , sender  :: String                  , subject :: String                  , text    :: String-                 , send    :: Bool +                 , send    :: Bool                  } deriving (Show)  sendMail      :: Table -> (RowInfo -> Email) -> IO ()-sendMail t f  = forM_ (mapRows f t) sendMail1 +sendMail t f  = forM_ (mapRows f t) sendMail1  sendMail1 :: Email -> IO () sendMail1 e = do   let tmp  = uid e-  let cmd  = mailCmd e +  let cmd  = mailCmd e   writeFile tmp (text e)-  status  <- if (send e) then show `fmap` system cmd else return "FAKESEND"-  putStrLn $ printf "[exec: %s] Status[%s]: %s %s" cmd (status) (uid e) (to e)+  status  <- if send e then show `fmap` system cmd else return "FAKESEND"+  putStrLn $ printf "[exec: %s] Status[%s]: %s %s" cmd status (uid e) (to e)  mailCmd :: Email -> String-mailCmd e = +mailCmd e =     printf "mail -s \"%s\" -aFrom:%s %s %s < %s" (subject e) (sender e) (to e) (ccs $ cc e) (uid e)   where     ccs [] = ""     ccs xs = "-c " ++ intercalate "," xs---

@@ -3,50 +3,77 @@    -- * Core Operators     join, joinBy-  -  -- * Join using default row for missing keys ++  -- * Join using default row for missing keys   , padJoin, padJoinBy    -- * Difference of two tables   , diff, diffBy-  +   -- * Index a table by a key-  , index, indexBy- -  -- * Order by the values of a particular column +  , index+  , indexBy++  -- * Order by the values of a particular column   , sortBy-  +   -- * Restrict table to a subset of columns   , project   , project1-  +  , hide+   -- * Move a column to first (leftmost) position   , moveColL    -- * Map a function over all rows   , mapRows+  , newColumn++   ) where  import           Text.CSV import           System.FilePath import           Control.Applicative ((<$>)) import           Data.Maybe-import           Data.List (sort, elemIndex)+import qualified Data.List as L import qualified Data.Map.Strict as M import           Data.CSV.Table.Types ++--------------------------------------------------------------------------------+-- | Sort by a given column, and ordering+--------------------------------------------------------------------------------+sortBy :: Col ->  TField -> Order -> Table -> Table+sortBy c t o tab = tab { body = L.sortBy (cmpRow i t o) (body tab)}+  where+    i            = columnIndex tab c++cmpRow :: Int -> TField -> Order -> Row -> Row -> Ordering+cmpRow i t o (R fs) (R fs') = orient o $ compareAs t (fs !! i) (fs' !! i)++compareAs :: TField -> Field -> Field -> Ordering+compareAs FStr x y = compare       x                  y+compareAs FInt x y = compare (read x :: Int)    (read y :: Int)+compareAs FDbl x y = compare (read x :: Double) (read y :: Double)++orient :: Order -> Ordering -> Ordering+orient Dsc LT = GT+orient Dsc GT = LT+orient _   x  = x+ ------------------------------------------------------------------- -- | Swap two columns of a table ------------------------------------------------------------------- moveColL      :: Table -> Col -> Table-moveColL t@(T n cs b) c +moveColL t@(T n cs b) c   | i == 0    = t   | otherwise = T n (pluck i cs) [R $ pluck i r | R r <- b]   where      i        = columnIndex t c -pluck n xs = go [] n xs-  where +pluck              = go []+  where     go ls 0 (r:rs) = r : (ls +++ rs)     go ls n (r:rs) = go (r:ls) (n-1) rs @@ -54,31 +81,31 @@ (x:xs) +++ ys = xs +++ (x:ys)  ---------------------------------------------------------------------- | Join two tables by first column (which should be unique) +-- | Join two tables by first column (which should be unique) -------------------------------------------------------------------  join       :: Table -> Table -> Table-join t1 t2 = T n' cs b' +join t1 t2 = T n' cs b'   where     m1     = index t1-    m2     = index t2 +    m2     = index t2     m'     = M.intersectionWith (\r1 r2 -> r1 ++ tail r2) m1 m2     b'     = R <$> M.elems m'     n'     = dim t1 + dim t2 - 1-    cs     = (cols t1) ++ (tail $ cols t2)+    cs     = cols t1 ++ tail (cols t2)  index   :: Table -> M.Map Field [Field] index t = M.fromList [(head r, r) | r <- getRows t]   ---------------------------------------------------------------------- | Join two tables by any unique column +-- | Join two tables by any unique column -------------------------------------------------------------------  joinBy         :: Col -> Table -> Table -> Table-joinBy c t1 t2 = join t1' t2' -  where -    t1'        = moveColL t1 c +joinBy c t1 t2 = join t1' t2'+  where+    t1'        = moveColL t1 c     t2'        = moveColL t2 c  --------------------------------------------------------------------@@ -87,10 +114,10 @@  diff :: Table -> Table -> Table diff t1@(T n1 c1 b1) t2 = T n1 c1 b1'-  where +  where     m1     = index t1     m2     = index t2-    m1'    = M.difference m1 m2  +    m1'    = M.difference m1 m2     b1'    = R <$> M.elems m1'  --------------------------------------------------------------------@@ -99,13 +126,13 @@  diffBy :: Col -> Table -> Table -> Table diffBy c t1 t2 = diff t1' t2'-  where -    t1'        = moveColL t1 c +  where+    t1'        = moveColL t1 c     t2'        = moveColL t2 c   ----------------------------------------------------------------------- | Join two tables by first column, using default row for missing keys +-- | Join two tables by first column, using default row for missing keys -------------------------------------------------------------------  padJoin :: Row -> Table -> Table -> Table@@ -118,10 +145,10 @@     m'     = M.intersectionWith (\r1 r2 -> r1 ++ tail r2) m1 (M.union m2 m2')     b'     = R <$> M.elems m'     n'     = dim t1 + dim t2 - 1-    cs     = (cols t1) ++ (tail $ cols t2)+    cs     = (cols t1) ++ tail (cols t2)  ----------------------------------------------------------------------- | Join two tables by any unique column, using default row for missing keys +-- | Join two tables by any unique column, using default row for missing keys -------------------------------------------------------------------  padJoinBy c r t1 t2 = padJoin r t1' t2'@@ -129,16 +156,19 @@     t1'             = moveColL t1 c     t2'             = moveColL t2 c ----------------------------------------------------------------------- | Index table by any column --------------------------------------------------------------------+--------------------------------------------------------------------------------+--- | Index table by unique column+-------------------------------------------------------------------------------- -indexBy       :: Table -> Col -> M.Map Field [Field]-indexBy t c    +indexBy     :: Table -> Col -> Table+indexBy t c = t { body = [ R fs | (_, fs) <- M.toList $ indexBy' t c] }++indexBy'       :: Table -> Col -> M.Map Field [Field]+indexBy' t c   | ok        = M.fromList [ (r !! i, r) | r <- getRows t]   | otherwise = error $ "indexBy: " ++ show c ++ " is not a unique column!"   where-    i         = columnIndex t c +    i         = columnIndex t c     ok        = isUnique    t c  -------------------------------------------------------------------@@ -148,9 +178,9 @@ isUnique      :: Table -> Col -> Bool isUnique t c  = not $ isDup $ project1 t c -isDup xs      = (length xs) /= (length xs') where xs' = nubOrd xs+isDup xs      = length xs /= length xs' where xs' = nubOrd xs -nubOrd        = go . sort+nubOrd        = go . L.sort   where     go []     = []     go (x:xs) = x : go ys where (_,ys) = span (x ==) xs@@ -161,7 +191,7 @@  project1     :: Table -> Col -> [Field] project1 t c = [ r !! i | r <- getRows t]-  where +  where     i        = columnIndex t c  project      :: Table -> [Col] -> Table@@ -170,24 +200,20 @@     body'    = projRow is' <$> body t     is       = (t `columnIndex`) <$> cs     n        = length is-    is'      = sort is-    -projRow is (R xs) = R [ xs !! i | i <- is ] +    is'      = L.sort is +projRow is (R xs) = R [ xs !! i | i <- is ] ----------------------------------------------------------------------- | Sort table by a particular column--------------------------------------------------------------------+hide :: Table -> [Col] -> Table+hide t cs = project t (cols t L.\\ cs) -sortBy     :: Table -> Col -> Table-sortBy t c = t { body = [ R fs | (_, fs) <- M.toList $ indexBy t c] }  ------------------------------------------------------------------- -- | Map a function over all rows of a table -------------------------------------------------------------------  mapRows   :: (RowInfo -> a) -> Table -> [a]-mapRows f = map f . rowCols   +mapRows f = map f . rowCols  rowCols   :: Table -> [RowInfo] rowCols t = [zip cs r | r <- rs]@@ -196,9 +222,24 @@     rs    = getRows t  -------------------------------------------------------------------+-- | Map a function over all rows of a table+-------------------------------------------------------------------+newColumn :: Col -> (RowInfo -> Field) -> Table -> Table+newColumn c f t = addColumn t c (mapRows f t)++addColumn :: Table -> Col -> [Field] -> Table+addColumn t c fs = T n' cs' b'+  where+    n'   = 1 + dim t+    cs'  = cols t ++ [c]+    b'   = zipWith addField (body t) fs++addField :: Row -> Field -> Row+addField (R fs) f = R (fs ++ [f])++------------------------------------------------------------------- -- | Helpers -------------------------------------------------------------------  columnIndex     :: Table -> Col -> Int-columnIndex t c = fromJust $ elemIndex c $ cols t -+columnIndex t c = fromJust $ L.elemIndex c $ cols t

@@ -4,19 +4,22 @@   -- * Representation     Table (..)   , Row (..)-  , Col (..) -  , RowInfo +  , Col (..)+  , RowInfo+  , TField (..)+  , Order (..)    -- * Accessors   , getCols   , getRows   , lookupCol -  -- * Parsing +  -- * Parsing   , fromFile+  , fromString    -- * Saving-  , toFile +  , toFile    ) where @@ -38,7 +41,7 @@  data Table  = T { dim :: Int, cols :: [Col], body :: [Row]} -{-@ measure width :: Row -> Int +{-@ measure width :: Row -> Int     width (R xs) = (len xs)                                                     @-}  {-@ type ColsN N = {v:[Col] | (len v)   = N}                                    @-}@@ -54,35 +57,44 @@ lookupCol :: Col -> RowInfo -> Field lookupCol c cxs = fromMaybe err $ lookup c cxs   where-    err         = printf "lookupCol: cannot find %s in %s" (show c) (show cxs) - +    err         = printf "lookupCol: cannot find %s in %s" (show c) (show cxs)++--------------------------------------------------------------------------------+-- | Field Sorts+--------------------------------------------------------------------------------++data TField = FStr | FInt | FDbl+            deriving (Eq, Ord, Show)++data Order  = Asc | Dsc+            deriving (Eq, Ord, Show) ------------------------------------------------------------------------- | Converting to CSV +-- | Converting to CSV ----------------------------------------------------------------------  fromCSV        :: CSV -> Table fromCSV []     = error "fromCSV: Empty CSV with no rows!"-fromCSV (r:rs) = T n cs b +fromCSV (r:rs) = T n cs b   where     n          = length r     cs         = [C x | x <- r]-    b          = mapMaybe (makeRow n) $ zip [0..] rs                        +    b          = mapMaybe (makeRow n) $ zip [0..] rs  makeRow :: Int -> (Int, Record) -> Maybe Row-makeRow n (i, xs) +makeRow n (i, xs)   | length xs == n = Just $ R xs-  | empty xs       = Nothing +  | empty xs       = Nothing   | otherwise      = error $ printf "Row %d does not have %d columns:\n%s" i n (show xs)  empty :: Record -> Bool empty = null . unwords  toCSV   :: Table -> CSV-toCSV t = [c | C c <- cols t] : [xs | R xs <- body t] +toCSV t = [c | C c <- cols t] : [xs | R xs <- body t] ----------------------------------------------------------------------- | Parsing --------------------------------------------------------------------+--------------------------------------------------------------------------------+-- | Parsing+--------------------------------------------------------------------------------  toFile   :: FilePath -> Table -> IO () toFile f = writeFile f . show@@ -93,15 +105,13 @@ fromString      :: FilePath -> String -> Table fromString fp s = fromCSV $ parseCSV' fp s -parseCSV' fp s = case parseCSV fp s of +parseCSV' fp s = case parseCSV fp s of                    Right c -> c                    Left e  -> error $ printf "parseCSV': %s" (show e) --------------------------------------------------------------------+-------------------------------------------------------------------------------- -- | Printing--------------------------------------------------------------------+--------------------------------------------------------------------------------  instance Show Table where   show = printCSV . toCSV--