diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,43 @@ module Main where import Villefort.Server (villefort) -import Villefort.Config (defaultConfig) +import Villefort.Config (defaultConfig,defWeekly) +import Villefort.Definitions(database + ,monday + ,tuesday + ,wednesday + ,thursday + ,friday + ,weekly) main :: IO () -main = villefort defaultConfig +main = villefort defaultConfig { + database= "/home/alice/dotfiles/todo.db" + ,weekly = utSchedule + + } + +utSchedule = defWeekly { + monday = [return ["Type up m408c notes","408c notes","m408"] + ,return ["Type up ugs303 lecture notes","ugs303 notes","ugs303"] + ,return ["Do m408c homework","m408c hw","m408"] + ,return ["Do cs314hw for Friday","cs314 hw", "cs314"] + ,return ["Do cs311hw for Friday","cs311 hw", "cs211"] + ], + tuesday = [return ["Type up cs311 lecture notes","cs311 notes","cs311"] + ,return ["Type up cs314 lecture notes","cs314 notes","cs314"] + ], + wednesday = [return ["Type up m408c notes","408c notes","m408"] + ,return ["Type up ugs303 lecture notes","ugs303 notes","ugs303"] + ,return ["Do m408c homework","m408c hw","m408"] + ], + thursday = [return ["Type up cs311 lecture notes","cs311 notes","cs311"] + ,return ["Type up cs314 lecture notes","cs314 notes","cs314"] + ], + + friday = [return ["Type up m408c notes","408c notes","m408"] + ,return ["Type up ugs303 lecture notes","ugs303 notes","ugs303"] + ,return ["Do m408c homework","m408c hw","m408"] + ] + } + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,160 @@ # Villefort Villefort is a time management system written in Haskell. -## Version 1.2.14 -- Rewrote scheduling functions so that monthly and yearly task run now. -- Cleaned up significant portions of code base. +## Version 1.2.15 +- New Task Data type with better scheduling options +- Running tasks is now fault tolerant. If one task fails the tasks after it still run. +- You can now store aribitrary vars in the task database +### New Task Data Type +```haskell +data Date = Date {year :: String, -- | The specific date you want a task to be on + month :: String, + day :: String } + | Offset {offset :: Int} -- | The number of days in the future you want the task to be due on + | Today -- | Make the task due today + deriving (Show,Eq) + +-- | Villefort's internal representation of Tasks +data Task = Task {title :: String, + description :: String, + subject :: String, + due :: Date} deriving (Show,Eq) + +``` +Example + +```haskell +cs314n :: IO Task +cs314n = pure $ Task { + title = "cs314 notes", + description = "Type up cs314 lecture notes", + subject = "cs314", + due = Today} +``` +### Storing Vars in the Database +```haskell +module Main where + +import Villefort.Server (villefort) +import Villefort.Config (defaultConfig,defWeekly) +import Villefort.Definitions +import Villefort.Database +import Control.Monad.Reader +import System.Random + +main :: IO () +main = check >> villefort conf + +conf = defaultConfig { + database= "dotfiles/todo.db" + ,weekly = schedule + } + +-- | checks if vars exists and if they don't initialize them with their default vals +check :: IO () +check = do + isBack <- runReaderT (isVar "back" ) conf + if isBack then pure () else runReaderT (updateVar "back" (show 5.0)) conf + isCrunch <- runReaderT (isVar "crunch" ) conf + if isBack then pure () else runReaderT (updateVar "crunch" (show 5.0)) conf + + +schedule = defWeekly { + monday = [a121cn + ,eng301n + ,a121chw + ,back + ], + tuesday = [cs101n + ,cs121n + ], + wednesday = [a121cn + ,eng301n + ,a121chw + ,back + ], + thursday = [cs101n + ,cs101hw + ,crunches + ], + friday = [eng301n + ,a121chw + ,back + ], + saturday = [crunches] + } + +cs121hw :: IO Task +cs121hw = pure $ Task {title="cs121 hw", + description="Do cs121hw for Friday", + subject="cs211", + due =Offset 4} +cs101hw :: IO Task +cs101hw = pure $ Task { title ="cs101 hw", + description ="Do cs101hw for Friday", + subject = "cs101", + due = Offset 7} +cs101n :: IO Task +cs101n = pure $ Task { + title = "cs101 notes", + description = "Type up cs101 lecture notes", + subject = "cs101", + due = Today} + +cs121n :: IO Task +cs121n = pure $ defTask { + title = "cs121 notes", + description = "Type up cs121 lecture notes", + subject = "cs121"} + +eng301n :: IO Task +eng301n = pure $ defTask { + title = "eng301 notes", + description = "Type up eng301 lecture notes", + subject = "eng301" + } + +a121chw :: IO Task +a121chw = pure $ defTask { + title = "a121c hw", + description = "Do a121c homework", + subject = "a121c" + } + +a121cn :: IO Task +a121cn = pure $ defTask { + title = "a121c notes", + description = "Type up a121c lecture notes", + subject = "a121c" + } + +cs101 :: IO Task +cs101 = pure $ Task { + title = "cs101 hw", + description = "Do cs101hw for Friday", + subject = "cs101", + due = Offset 7} + +back = exercise "back" 1 +crunches = exercise "crunch" 1 + +exercise var increment = do + res <- flip runReaderT conf $ getVar var + putStrLn $ show res + let num = read res :: Double + flip runReaderT conf (updateVar var ( show ( num+increment))) + listB <- gener num + return $ Task var ("do " ++ show listB++ " " ++ var) "exercise" Today + +gener :: Double -> IO [Int] +gener level = do + dubs <- mapM gen $ replicate 5 level :: IO [Double] + return $ map floor dubs + where gen x = randomRIO (x-(x/3),x+(x/3)) +``` + + [default config](https://github.com/alicereuter/Villefort/blob/master/src/Villefort/Config.hs) # Home screen @@ -24,46 +174,6 @@ ## Configure your villefort create a custom main method in ~.villefort/villefort.hs. Below is an example. - -```haskell -module Main where - -import Villefort.Server -import Villefort.Config -import Villefort.Definitions -import System.Random -import System.IO.Strict as S - -main :: IO () -main = villefort def { - daily = [calendar ], - weekly = defWeekly { - monday = [push], - wednesday = [push], - friday = [push, - scan] - - } - } - --- description, heading, subject -calendar = pure ["","check calendar","admin"] -scan = pure ["scan notes","scan","admin"] - --- | generate increasing sets of push ups -push = do - rawNum <- S.readFile "push" -- readfile to get # push ups - let num = read rawNum :: Double - writeFile "push" (show (num+0.3)) - sets <- pushUps num - return $ [show sets,"push ups","fit"] - -pushUps level = do - dubs <- mapM gen $ replicate 5 level :: IO [Double] - return $ map floor dubs - where gen x = randomRIO (x-(x/3),x+(x/3)) - -``` Use ```Villefort --recompile``` to recompile Villefort with your custom config. Recompilation requires ghc to be in your $PATH. The next time you run villefort it will run with your custom config. The default Config is found in Villefort.Config. diff --git a/Villefort.cabal b/Villefort.cabal --- a/Villefort.cabal +++ b/Villefort.cabal @@ -1,5 +1,5 @@ name: Villefort -version: 0.1.2.14 +version: 0.1.2.15 synopsis: Villefort is a task manager and time tracker description: Villefort is a browser based time tracker built around a sqlite3 database. homepage: https://github.com/alicereuter/Villefort#readme @@ -22,7 +22,6 @@ , templates/boot.css , templates/jqui.css , templates/bs.js - library hs-source-dirs: src other-modules: Paths_Villefort @@ -73,6 +72,7 @@ , text , time , random + , mtl default-language: Haskell2010 test-suite Villefort-test diff --git a/data/todo.db b/data/todo.db Binary files a/data/todo.db and b/data/todo.db differ diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs --- a/src/Villefort/Config.hs +++ b/src/Villefort/Config.hs @@ -1,4 +1,4 @@ -module Villefort.Config (defaultConfig) where +module Villefort.Config where import Villefort.Definitions (VConfig(..) , daily @@ -22,36 +22,38 @@ -- | Default configuration of VConfig defaultConfig :: VConfig defaultConfig = VConfig { - daily = [return []], -- tasks that get added daily - monthly =[return []], -- tasks that get added on the first of each month - yearly =[return []], -- taksks that get added on the first of the year - weekly = defWeekly, -- tasks to run on a given week day - port = 3002, -- port number - noCustom = False, -- flag for debugging stops launching custom executable - showDatabase = False, -- optionally prints database path - colors = defColors, -- Colors to use first is closest task - database = [] -- sets path to database useful to have database in your custom path - } + daily = [], -- | tasks that get added daily + monthly =[], -- | tasks that get added on the first of each month + yearly =[], -- | tasks that get added on the first of the year + weekly = defWeekly, -- | tasks to run on a given week day + port = 3002, -- | port number + noCustom = False, -- | flag for debugging stops launching custom executable + showDatabase = False, -- | optionally prints database path + colors = defColors, -- | Colors to use first is closest task + database = [], -- | sets path to database useful to have database in your custom path + dailyPollFrequency = 18000000 -- | the amount of time in microsecond villefort waits to check if the datae changed again + } -- | Default weekly schedule by default is empty defWeekly :: Weekly defWeekly = Weekly { - monday = [return []], - tuesday =[return[]], - wednesday = [return[]], - thursday = [return[]], - friday = [return[]], - saturday = [return[]], - sunday = [return []] + monday = [], -- | the tasks to run on monday + tuesday =[], -- | the tasks to run on tuesday + wednesday = [],-- | the tasks to run on wednesday + thursday = [], -- | the tasks to run on thursday + friday = [], -- | the tasks to run on friday + saturday = [], -- | the tasks to run on saturday + sunday = [] -- | the tasks to run on sunday } + -- | Default colors for Villefort defColors :: [String] -defColors = ["#0d47a1" -- tasks due today and earlier - ,"#1565c0" -- tasks due tomorrow - ,"#1976d2" -- tasks due in 2 days - ,"#1e88e5" -- tasks due in 3 days - ,"#2196f3" -- tasks due in 4 days - ,"#42a5f5" -- tasks due in 5 days - ,"#64b5f6" -- tasks due in 6 days +defColors = ["#0d47a1" -- | tasks due today and earlier + ,"#1565c0" -- | tasks due tomorrow + ,"#1976d2" -- | tasks due in 2 days + ,"#1e88e5" -- | tasks due in 3 days + ,"#2196f3" -- | tasks due in 4 days + ,"#42a5f5" -- | tasks due in 5 days + ,"#64b5f6" -- | tasks due in 6 days ,"#90caf9"] diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs --- a/src/Villefort/Daily.hs +++ b/src/Villefort/Daily.hs @@ -2,7 +2,8 @@ module Villefort.Daily (dailyCheck ) where import Villefort.Definitions (VConfig(..) - , Weekly(..)) + , Weekly(..) + , Task(..)) import Villefort.Database (execQuery, makeQuery, addDaily) import Control.Monad.Reader (MonadIO,MonadReader,runReaderT,forever,liftIO) import Control.Concurrent (threadDelay) @@ -14,6 +15,7 @@ ,year ,getDate ,getDateD) +import Control.Exception(onException) -- | writes date to local database writeDate :: (MonadReader VConfig m, MonadIO m) => m () @@ -40,31 +42,43 @@ let int = read (head $ head $ rawDay) :: Int return int - -runCheck ∷ Eq x ⇒ VConfig → D → D → (VConfig → [IO [String]]) → (D → x) → String → IO () +runCheck ∷ Eq x ⇒ VConfig → D → D → (VConfig → [IO Task]) → (D → x) → String → IO () runCheck vconf oldDate currentDate extract extractInt addText = if notrun then return () else do putStrLn addText - todo ← sequence (extract vconf) - mapM_ add todo - where add = (\x → if null x then return () else runReaderT (addDaily x) vconf) - notrun = (extractInt oldDate == extractInt currentDate) + todo ← sequence' (extract vconf) :: IO [Task] + mapM_ (add vconf) todo + where notrun = (extractInt oldDate == extractInt currentDate) -- | Runs days of the week specific tasks runWeekly :: VConfig -> Int -> Int -> IO () -runWeekly conf old current = do +runWeekly vconf old current = do if old /= current then do - let stmt = selector conf (current-1) - stmts <- sequence stmt - mapM_ add stmts + let stmt = selector vconf (current-1) + stmts <- sequence' stmt + mapM_ (add vconf) stmts else putStrLn "didn't run weekly" - where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf) +add :: VConfig -> Task -> IO () +add conf x = runReaderT ( addDaily x) conf + +-- | Exception catching version of sequence used +-- | to throw errors if indivuals task fail, but +-- | still allowing non failing tasks to run +sequence' :: [IO Task] -> IO [Task] +sequence' [] = pure [] +sequence' list = do + let currentTask = head list + res <- onException currentTask $ putStrLn $ "task failed to run" + rest <- sequence' $ tail list + pure $ res : rest + + -- | selects correct tasks based on day of the week -selector :: (Num a, Eq a) => VConfig -> a -> [IO [String]] +selector :: (Num a, Eq a) => VConfig -> a -> [IO Task] selector conf x | x == 0 = monday lookconf | x == 1 = tuesday lookconf @@ -74,7 +88,7 @@ | x == 5 = saturday lookconf | otherwise = sunday lookconf where lookconf = weekly conf - + -- | Run daily check for updates dailyCheck :: VConfig -> IO () dailyCheck conf = forever $ do diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs --- a/src/Villefort/Database.hs +++ b/src/Villefort/Database.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, FlexibleContexts #-} module Villefort.Database (makeQuery ,getSubjects ,execQuery @@ -6,8 +6,16 @@ ,clean ,getDone ,getDb + ,updateVar + ,getVar + ,isVar + ,run + ,varTableExists + ,makeTable ,addTask) where +import Villefort.Definitions (VConfig(..),Task(..),Date(..)) + import Control.Monad.Reader (MonadIO,MonadReader,liftIO,ask) import Database.HDBC.Sqlite3 (Connection,connectSqlite3) import Database.HDBC (SqlValue @@ -17,15 +25,41 @@ ,toSql ,fromSql ,quickQuery' + ,getTables + ,runRaw ,prepare) +import Control.Monad.Reader (runReaderT) import System.Environment (getArgs) import Paths_Villefort (getDataDir) -import Villefort.Definitions (VConfig(..)) import Data.Convertible.Base (Convertible) +import Data.Time.Calendar +import Data.Time.LocalTime +import Text.Printf +-- | checks if var table exists +varTableExists :: String -> IO Bool +varTableExists path = do + conn <- connectSqlite3 path + table <- getTables conn + disconnect conn + pure $ elem "vars" table + +constructTable path = do + conn <- connectSqlite3 path + runRaw conn "CREATE TABLE vars (id TEXT,val TEXT);" + commit conn + disconnect conn + +makeTable path = do + isTable <- varTableExists path + if not isTable then putStrLn "[var] inserting var table for upgrade to Villefort 0.1.2.15 this will only run once" >> constructTable path else pure () + + -- | gets list of subjects from local database getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String] -getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject" +getSubjects = do + subjects <- makeQuery "select Subject from todo where state = 0 group by Subject" + pure $ map (\x-> (!! 0) <$> x) subjects -- | get paths tests for --custom flag to allow for executing custom builds path' :: (MonadReader VConfig m, MonadIO m) => m FilePath @@ -40,7 +74,6 @@ else liftIO $ getDataDir else liftIO $ getDataDir if s then (liftIO $ putStrLn =<< getDataDir) >> cont else cont - -- | connects to database checks if custom database path is set getDb :: (MonadReader VConfig m, MonadIO m) => m Connection @@ -57,18 +90,58 @@ convRow :: [[SqlValue]] -> [[String]] convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat +-- | get databse var +getVar :: (MonadReader VConfig m, MonadIO m) => String -> m String +getVar varName = do + let stmt = ("select val from vars where id = \"" ++ varName ++ "\"") + liftIO $ putStrLn stmt + (!! 0) <$> ( !! 0) <$> makeQuery' stmt [] +-- | inserts a given task into the database +run :: IO Task -> VConfig -> IO () +run task conf = do + text <- liftIO task + runReaderT (addDaily text) conf + putStrLn $ "[run] sucessfully ran task" ++ show text + +-- | if var varName exists updates it's value to val +-- | it instiates the variable and sets if it doesn't exit. +updateVar :: (MonadReader VConfig m, MonadIO m) => String -> String -> m () +updateVar varName val = do + let sqlid = toSql varName + let sqlval = toSql val + varExists <- isVar varName + if varExists + then execQuery "INSERT INTO vars (id,val) VALUES (?,?)" [sqlid,sqlval] + else execQuery "UPDATE vars SET val = ? WHERE id = ?" [sqlval,sqlid] + +-- | checks if var exists in stabase +isVar :: (MonadReader VConfig m,MonadIO m) => String -> m Bool +isVar varName = do + varExists <- makeQuery $ "SELECT val FROM vars where id = '" ++ varName ++ "'" + return $ null varExists + -- | takes sqlQuery and returns results as a string +makeQuery' :: (MonadReader VConfig m, MonadIO m) => String -> [SqlValue]-> m [[String]] +makeQuery' query params = do + conn <- getDb + taskRaw <- liftIO $ quickQuery' conn query params + liftIO $ disconnect conn + return (convRow taskRaw) + +-- | takes sqlQuery and returns results as a string makeQuery :: (MonadReader VConfig m, MonadIO m) => String -> m [[String]] -makeQuery query = do +makeQuery query = do conn <- getDb taskRaw <- liftIO $ quickQuery' conn query [] liftIO $ disconnect conn - return (convRow taskRaw) + return (convRow taskRaw) + + -- | executes a query that changes values in database -execQuery :: (Convertible a SqlValue, - MonadIO m, - MonadReader VConfig m) => String -> [a] -> m () +execQuery :: (Convertible a SqlValue, MonadIO m, + MonadReader VConfig m) => + String -> [a] -> m () execQuery query params = do conn <- getDb stmt <- liftIO $ prepare conn query @@ -79,7 +152,7 @@ -- | gets the task id for the next avaible todo getNextId :: (MonadReader VConfig m, MonadIO m) => m Integer getNextId = do - f <- makeQuery "select id from todo order by id desc" + f <- makeQuery "select id from todo order by id desc" let rawid = head $ f pure $ (read (rawid !! 0) :: Integer) +1 @@ -87,17 +160,33 @@ addTask :: (MonadReader VConfig m, MonadIO m) => String -> String -> String -> String -> m () addTask todoSummary todoTitle date todoSubject = do nextSqlId <- getNextId - execQuery "insert into todo (id,Description,Title,Entered,Due,State,time,Subject) Values (?,?,?,datetime('now', 'localtime'),?,1,0,?)" [show nextSqlId, (clean todoSummary),(clean todoTitle), date, (clean todoSubject)] + execQuery "insert into todo (id,Description,Title,Entered,Due,State,time,Subject) Values (?,?,?,datetime('now', 'localtime'),?,1,0,?)" [show nextSqlId, (clean todoSummary),(clean todoTitle), date, (clean todoSubject)] -- | logs new daily entry due on same day -addDaily :: (MonadReader VConfig m, MonadIO m) => [String] -> m () -addDaily addD= do +addDaily :: (MonadReader VConfig m, MonadIO m) => Task -> m () +addDaily addedTask = do lastRowId <- getNextId - execQuery "insert into todo (id,Description,Title,Entered,Due,State,time,Subject ) Values (?,?,?,current_date,current_date,1,0,?)" $ [show lastRowId] ++ addD + date <-liftIO $ makeDate $ due addedTask + execQuery "insert into todo (id,Description,Title,Entered,Due,State,time,Subject ) Values (?,?,?,current_date,?,1,0,?)" $ [show lastRowId, description addedTask, title addedTask, date, subject addedTask] +makeDate :: Date -> IO String +makeDate (Date year month day) = pure $ fmtDate year month day +makeDate (Today) = do + (year,month,day) <- (toGregorian . localDay . zonedTimeToLocalTime) <$> getZonedTime :: IO (Integer, Int , Int) + pure $ fmtDate year month day +makeDate (Offset x) = do + start <- (localDay . zonedTimeToLocalTime) <$> getZonedTime + let actualDay = addDays (toInteger x) start + let (year,month,day) = toGregorian actualDay + pure $ fmtDate year month day + +fmtDate y m d =fmt y ++ "-" ++ fmt m ++ "-" ++ fmt d + where fmt x = printf "%02d" x + -- | lists the todo items finished today getDone :: (MonadReader VConfig m, MonadIO m) => m [[String]] getDone = makeQuery "select Title, time from todo where substr(Due,1,10) = Date('now','localtime') and time != 0" + -- | rudimentary sanitization clean :: String -> String diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs --- a/src/Villefort/Definitions.hs +++ b/src/Villefort/Definitions.hs @@ -1,25 +1,41 @@ -module Villefort.Definitions (VConfig (..),Weekly(..)) where +module Villefort.Definitions (VConfig (..),Weekly(..),Task(..),Date(..),defTask) where -- | Villefort Configuration data data VConfig = VConfig { - daily :: [IO [String]], - monthly :: [IO [String]], - yearly :: [IO [String]], + daily :: [IO Task], + monthly :: [IO Task], + yearly :: [IO Task], weekly :: Weekly, colors :: [String], port :: Int, noCustom :: Bool, showDatabase :: Bool, - database :: String + database :: String, + dailyPollFrequency :: Integer } -- | Villefort Weekly task datatype data Weekly = Weekly { - monday :: [IO[String]], - tuesday :: [IO[String]], - wednesday :: [IO[String]], - thursday :: [IO[String]], - friday :: [IO[String]], - saturday :: [IO[String]], - sunday ::[IO[String]] + monday :: [IO Task], + tuesday :: [IO Task], + wednesday :: [IO Task], + thursday :: [IO Task], + friday :: [IO Task], + saturday :: [IO Task], + sunday ::[IO Task] } +data Date = Date {year :: String, -- | The specific date you want a task to be on + month :: String, + day :: String } + | Offset {offset :: Int} -- | The number of days in the future you want the task to be due on + | Today -- | Make the task due today + deriving (Show,Eq) + +-- | Villefort's internal representation of Tasks +data Task = Task {title :: String, + description :: String, + subject :: String, + due :: Date} deriving (Show,Eq) + +defTask :: Task +defTask = Task "" "" "" Today diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs --- a/src/Villefort/Server.hs +++ b/src/Villefort/Server.hs @@ -13,7 +13,7 @@ import Control.Monad.Reader (liftIO,runReaderT) import Control.Concurrent (forkIO) import Data.Text.Lazy (pack) -import Villefort.Database (addTask) +import Villefort.Database import Villefort.Todo (deleteTodo,getTodos,updateTodos) import Villefort.Log (genStats) import Villefort.Definitions (VConfig(..)) @@ -43,6 +43,8 @@ -- | Entry point for server attempts to recompile if needed villefort :: VConfig -> IO () villefort conf = do + let path = database conf + makeTable path args <- getArgs case args of ["--custom",_] -> putStrLn "custom" >> launch conf @@ -73,9 +75,10 @@ then putStrLn "custom build detected" >> executeFile path True ["--custom",dataDir] Nothing else putStrLn "no custom build detected" + -- | actually launches the scotty server launch :: VConfig -> IO () -launch conf = do +launch conf = do _ <- forkIO $ dailyCheck conf scotty ( port conf) $ do get "/" $ do diff --git a/src/Villefort/Todo.hs b/src/Villefort/Todo.hs --- a/src/Villefort/Todo.hs +++ b/src/Villefort/Todo.hs @@ -11,6 +11,14 @@ import Control.Monad.Reader (MonadReader,MonadIO,liftIO,ask) import Data.Time (getZonedTime,fromGregorian,diffDays) +data Task = Task {rid :: Int, + title :: String, + description :: String, + due :: String, + subject :: String, + time :: Int + } deriving (Show,Eq) + -- | difference betweeen the current day and the supplied day daysUntil :: [Char] -> IO Integer daysUntil date = do @@ -20,18 +28,10 @@ let currentDateSplit = splitOn "-" current let currentDate = fromGregorian ( read (currentDateSplit !! 0) :: Integer) (read (currentDateSplit !! 1) :: Int) (read (take 2 ( currentDateSplit !! 2)) :: Int) return $ (diffDays dateWhenDue currentDate) - -data Row = Row { rid :: Int, - title :: String, - description :: String, - due :: String, - subject :: String, - time :: Int - } deriving (Show,Eq) -- | Used to create row takes time spent as an integer -toRow :: [String] -> Int -> Row -toRow x = Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4) +toRow :: [String] -> Int -> Task +toRow x = Task (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4) -- | update the time taken on a certain project updateTodos :: (MonadReader VConfig m, MonadIO m) => Int -> Int -> m () @@ -47,14 +47,13 @@ idval <- makeQuery' $ "select sum(time) from todo where id = " ++ show taskId pure $ (read ((idval !! 0) !! 0) :: Int) - -- | returns Row data structures for each open task -qetTasks' :: (MonadReader VConfig m, MonadIO m) => m [Row] +qetTasks' :: (MonadReader VConfig m, MonadIO m) => m [Task] qetTasks' = do x <- makeQuery' "select id, Title, Description, Due, Subject, pred from todo where state=1 group by id order by Due" let ids = map head x times <- mapM getTime ids - let halfRows = (map toRow x) :: [Int -> Row] + let halfRows = (map toRow x) :: [Int -> Task] return $ apply halfRows times -- | applies a list of functions to a list of values @@ -88,7 +87,7 @@ -- | generates modal for task based of Row data Structure -genModal' :: Row -> IO String +genModal' :: Task -> IO String genModal' row = if rid row == 1 then return (" ") else do let f = due row modal <- getModal