Villefort 0.1.2.14 → 0.1.2.15
raw patch · 10 files changed
+397/−128 lines, 10 filesdep ~mtl
Dependency ranges changed: mtl
Files
- Main.hs +38/−2
- README.md +153/−43
- Villefort.cabal +2/−2
- data/todo.db binary
- src/Villefort/Config.hs +27/−25
- src/Villefort/Daily.hs +28/−14
- src/Villefort/Database.hs +103/−14
- src/Villefort/Definitions.hs +28/−12
- src/Villefort/Server.hs +5/−2
- src/Villefort/Todo.hs +13/−14
Main.hs view
@@ -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"]+ ]+ }+
README.md view
@@ -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.
Villefort.cabal view
@@ -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
data/todo.db view
binary file changed (122880 → 122880 bytes)
src/Villefort/Config.hs view
@@ -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"]
src/Villefort/Daily.hs view
@@ -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
src/Villefort/Database.hs view
@@ -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
src/Villefort/Definitions.hs view
@@ -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
src/Villefort/Server.hs view
@@ -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
src/Villefort/Todo.hs view
@@ -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