summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAliceReuter <>2018-10-20 02:17:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-10-20 02:17:00 (GMT)
commit5224c13c849590fc81c702c1e83a396e365d68b3 (patch)
tree4074839cd399cec973e38d1c989b8c39248a026b
parent98ee49f499828d927c0945d88ae0e96c12363626 (diff)
version 0.1.2.150.1.2.15
-rw-r--r--Main.hs40
-rw-r--r--README.md196
-rw-r--r--Villefort.cabal4
-rw-r--r--data/todo.dbbin122880 -> 122880 bytes
-rw-r--r--src/Villefort/Config.hs52
-rw-r--r--src/Villefort/Daily.hs42
-rw-r--r--src/Villefort/Database.hs117
-rw-r--r--src/Villefort/Definitions.hs40
-rw-r--r--src/Villefort/Server.hs7
-rw-r--r--src/Villefort/Todo.hs27
10 files changed, 397 insertions, 128 deletions
diff --git a/Main.hs b/Main.hs
index bfb5faf..b7050cd 100644
--- 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
index c4f1c4d..da9c098 100644
--- a/README.md
+++ b/README.md
@@ -1,9 +1,159 @@
# 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)
@@ -25,46 +175,6 @@ Villefort is a time management system written in Haskell.
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
index e7a71d4..868c610 100644
--- 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 @@ data-files: data/todo.db
, templates/boot.css
, templates/jqui.css
, templates/bs.js
-
library
hs-source-dirs: src
other-modules: Paths_Villefort
@@ -73,6 +72,7 @@ executable Villefort
, text
, time
, random
+ , mtl
default-language: Haskell2010
test-suite Villefort-test
diff --git a/data/todo.db b/data/todo.db
index abad9b0..efcf38c 100644
--- a/data/todo.db
+++ b/data/todo.db
Binary files differ
diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs
index b460f53..0eef31d 100644
--- 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 @@ import Villefort.Definitions (VConfig(..)
-- | 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
index 16b68c6..f8434c8 100644
--- 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 @@ import Villefort.Util (D
,year
,getDate
,getDateD)
+import Control.Exception(onException)
-- | writes date to local database
writeDate :: (MonadReader VConfig m, MonadIO m) => m ()
@@ -40,31 +42,43 @@ readDay = do
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 @@ selector conf x
| 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
index 76894d4..20880b2 100644
--- 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 @@ module Villefort.Database (makeQuery
,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 @@ import Database.HDBC (SqlValue
,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 @@ path' = do
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 @@ getDb = do
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 @@ execQuery query params = do
-- | 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,18 +160,34 @@ getNextId = do
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
clean = id
diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs
index 4bba0ed..185a414 100644
--- 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
index 4fbe6e3..a783bc6 100644
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -13,7 +13,7 @@ import Web.Scotty (scotty
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 @@ convDate date = newDate
-- | 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 @@ checkCustomBuild = do
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
index 5c1cff3..2d22c00 100644
--- a/src/Villefort/Todo.hs
+++ b/src/Villefort/Todo.hs
@@ -11,6 +11,14 @@ import Database.HDBC (SqlValue,fromSql,quickQuery',disconnect)
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 @@ daysUntil date = do
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 @@ getTime taskId = do
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 @@ merge (x:xs) ys = x:merge ys xs
-- | 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