Permalink
Browse files

Added basic export command.

TODO: Allow filtering on start and finish time and key/value pairs.
  • Loading branch information...
1 parent 7108383 commit fb9166871377cc497f569c78fd8d9a604e2d6671 @sseefried committed Mar 2, 2012
Showing with 94 additions and 8 deletions.
  1. +80 −0 src/ExportCmd.hs
  2. +1 −1 src/FinishCmd.hs
  3. +2 −2 src/StartCmd.hs
  4. +4 −2 src/Task.hs
  5. +7 −3 src/Time.hs
View
80 src/ExportCmd.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE OverloadedStrings #-}
+module ExportCmd where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Text.Printf
+import System.Exit
+import Control.Monad
+import Data.Time
+import Data.Maybe (mapMaybe, isJust)
+import Data.Either (either)
+import Data.CSV.Enumerator
+import qualified Data.ByteString.Char8 as BS
+
+-- friends
+import GetOpt
+import Time
+import Errors
+import RecordSet
+import ParseOpts
+
+import Record (Record, RecordSet)
+import qualified Record as R
+
+--
+-- | Flags for the "start" command
+--
+data ExportCmdFlag =
+ ExportCmdStartTime UTCTime
+ | ExportCmdFinishTime UTCTime
+ | ExportCmdKey Text -- exporting rows just for this key
+
+--
+-- Given a UTCTime (to determine what day it is) and a TimeZone returns option descriptions
+-- for the start command
+--
+exportCmdOpts :: ZonedTime -> [OptDescr (Either String ExportCmdFlag)]
+exportCmdOpts zt =
+ [ Option "s" ["start-time"]
+ (OptArg (timeToExportCmd ExportCmdStartTime) "start time") "export from start time",
+ Option "f" ["finish-time"]
+ (OptArg (timeToExportCmd ExportCmdFinishTime) "finish time") "export until finish time"
+ , Option "k" ["key-value"] (OptArg keyToExportCmd "key") "key" ]
+ where
+ timeToExportCmd :: (UTCTime -> ExportCmdFlag) -> Maybe String
+ -> Either String ExportCmdFlag
+ timeToExportCmd f =
+ maybe (Left "You have not provided a time argument.")
+ (either Left (Right . f) . parseTimeFlag zt)
+ keyToExportCmd :: Maybe String -> Either String ExportCmdFlag
+ keyToExportCmd = maybe (Left "You have not provided a key/value argument.")
+ (Right . ExportCmdKey . T.pack)
+
+exportCmd :: ZonedTime -> [String] -> IO ()
+exportCmd zt args = do
+ let (opts, nonOpts, errors) = getOptEither Permute (exportCmdOpts zt) args
+ exitWithErrorIf (null nonOpts) "You have not provided a filename"
+ exitWithErrorIf (length nonOpts /= 1) "Please provide only one filename"
+ let [ filename ] = nonOpts
+ rs <- readRecordSet
+ finishTime <- getCurrentTime
+ let startTime = addUTCTime (-100*365*86400) finishTime -- a century ago
+ exportRecordsToCSV filename (zonedTimeZone zt) startTime finishTime rs
+ return ()
+
+exportRecordsToCSV :: String -> TimeZone -> UTCTime -> UTCTime -> RecordSet -> IO ()
+exportRecordsToCSV filename tz startTime finishTime rs = do
+ writeCSVFile defCSVSettings filename
+ (map (recordToRow tz) $ R.findBetween startTime finishTime rs)
+ return ()
+
+recordToRow :: TimeZone -> Record -> Row
+recordToRow tz r = [ (g . R.recStart $ r),
+ (g . R.recFinish $ r),
+ (f . R.recDescr $ r) ] ++ map h (R.recKeyValues r)
+ where
+ f = encodeUtf8
+ g = BS.pack . isoTime tz
+ h (key,value) = encodeUtf8 key `BS.append` ":" `BS.append` encodeUtf8 value
View
2 src/FinishCmd.hs
@@ -56,7 +56,7 @@ finishCmd zt args = do
(printf "Finish time is the same as or before start time")
rs' <- R.finishCurrent rs finish
writeRecordSet rs'
- printf "Finishing current task at '%s'\n" (prettyTime finish (zonedTimeZone zt))
+ printf "Finishing current task at '%s'\n" (prettyTime (zonedTimeZone zt) finish)
View
4 src/StartCmd.hs
@@ -64,10 +64,10 @@ startCmd zt args = do
exitWithErrorIf (lastFinish >= start)
-- FIXME: Clean up
(printf "Can't start a task at this time since the last record's finish time is at '%s'."
- (prettyTime lastFinish (zonedTimeZone zt)))
+ (prettyTime (zonedTimeZone zt) lastFinish))
writeCurrentRecord $ R.CurrentRecord descr start keyValues
printf "Creating new task at '%s' with description '%s'.\n"
- (prettyTime start (zonedTimeZone zt))
+ (prettyTime (zonedTimeZone zt) start)
(T.unpack descr)
getStartTime :: [StartCmdFlag] -> IO UTCTime
View
6 src/Task.hs
@@ -24,6 +24,7 @@ import StartCmd
import ModifyCmd
import ClearCmd
import FinishCmd
+import ExportCmd
import GetOpt
@@ -95,8 +96,9 @@ commands name zt =
undefined
, Cmd "export"
"Export task data in a variety of formats"
- (error "not defined")
- undefined
+ (usageInfo (printf "Usage: %s export [<flags>...]\n\nFlags:" name)
+ (exportCmdOpts zt))
+ (exportCmd zt)
]
commandMap :: String -> ZonedTime -> Map String Command
View
10 src/Time.hs
@@ -5,6 +5,7 @@ module Time (
-- standard libraries
import Data.Time
+import Data.Time.Format
import System.Locale (defaultTimeLocale)
import Text.Printf
@@ -38,6 +39,9 @@ parseTaskTime zt s
--
-- Converts UTC to local time and then pretty prints it
--
-prettyTime :: UTCTime -> TimeZone -> String
-prettyTime t tz = formatTime defaultTimeLocale "%a, %d %b %y %H:%M:%S"
- (utcToLocalTime tz t)
+prettyTime :: TimeZone -> UTCTime -> String
+prettyTime tz t = formatTime defaultTimeLocale "%a, %d %b %y %H:%M:%S"
+ (utcToLocalTime tz t)
+
+isoTime :: TimeZone -> UTCTime -> String
+isoTime tz t = formatTime defaultTimeLocale "%F %X" (utcToLocalTime tz t)

0 comments on commit fb91668

Please sign in to comment.