summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/CSV/Table/Email.hs25
-rw-r--r--src/Data/CSV/Table/Ops.hs135
-rw-r--r--src/Data/CSV/Table/Types.hs52
3 files changed, 130 insertions, 82 deletions
diff --git a/src/Data/CSV/Table/Email.hs b/src/Data/CSV/Table/Email.hs
index a121b3c..d70ac29 100644
--- a/src/Data/CSV/Table/Email.hs
+++ b/src/Data/CSV/Table/Email.hs
@@ -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.Types
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
-
-
-
diff --git a/src/Data/CSV/Table/Ops.hs b/src/Data/CSV/Table/Ops.hs
index c52f71d..feaf451 100644
--- a/src/Data/CSV/Table/Ops.hs
+++ b/src/Data/CSV/Table/Ops.hs
@@ -3,50 +3,77 @@ module Data.CSV.Table.Ops (
-- * 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 @@ pluck n xs = go [] n xs
(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 @@ joinBy c t1 t2 = join t1' t2'
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 @@ diff t1@(T n1 c1 b1) t2 = T n1 c1 b1'
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 @@ padJoin (R xs) t1 t2 = T n' cs b'
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 @@ padJoinBy c r t1 t2 = padJoin r t1' t2'
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 @@ indexBy t c
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 @@ nubOrd = go . sort
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 @@ project t cs = T n cs body'
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 @@ rowCols t = [zip cs r | r <- rs]
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
diff --git a/src/Data/CSV/Table/Types.hs b/src/Data/CSV/Table/Types.hs
index 1ab45e1..c81b170 100644
--- a/src/Data/CSV/Table/Types.hs
+++ b/src/Data/CSV/Table/Types.hs
@@ -4,19 +4,22 @@ module Data.CSV.Table.Types (
-- * 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 @@ type RowInfo = [(Col, Field)]
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 @@ getRows t = [r | R r <- body t]
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 @@ fromFile f = fromString f <$> readFile f
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
-
-