summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAliceReuter <>2018-08-06 20:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-08-06 20:46:00 (GMT)
commit98ee49f499828d927c0945d88ae0e96c12363626 (patch)
tree862a592c7ce9adb64b05a08470e2a75df4f51ccc
parent3914cef5dbdf12c1f96b520ad34efa9c2bd372f7 (diff)
version 0.1.2.140.1.2.14
-rw-r--r--LICENSE4
-rw-r--r--Main.hs7
-rw-r--r--README.md11
-rw-r--r--Villefort.cabal7
-rw-r--r--src/Villefort/Config.hs27
-rw-r--r--src/Villefort/Daily.hs83
-rw-r--r--src/Villefort/Database.hs27
-rw-r--r--src/Villefort/Definitions.hs8
-rw-r--r--src/Villefort/Server.hs39
-rw-r--r--src/Villefort/Todo.hs4
-rw-r--r--src/Villefort/Util.hs18
-rw-r--r--src/Villefort/Weekly.hs12
-rw-r--r--test/Spec.hs15
13 files changed, 124 insertions, 138 deletions
diff --git a/LICENSE b/LICENSE
index 572f060..c33f199 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Chris Reuter (c) 2017
+Copyright Alice Reuter (c) 2017
All rights reserved.
@@ -13,7 +13,7 @@ modification, are permitted provided that the following conditions are met:
disclaimer in the documentation and/or other materials provided
with the distribution.
- * Neither the name of Chris Reuter nor the names of other
+ * Neither the name of Alice Reuter nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
diff --git a/Main.hs b/Main.hs
index df1c2d0..bfb5faf 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,8 +1,7 @@
module Main where
-import Villefort.Server
-import Villefort.Definitions
-import Villefort.Config
+import Villefort.Server (villefort)
+import Villefort.Config (defaultConfig)
main :: IO ()
-main = villefort def
+main = villefort defaultConfig
diff --git a/README.md b/README.md
index b3557d6..c4f1c4d 100644
--- a/README.md
+++ b/README.md
@@ -1,9 +1,9 @@
# Villefort
Villefort is a time management system written in Haskell.
-## Version 1.2.13
-- Integrated date and day tracking into database to stop file corruption.
-
+## Version 1.2.14
+- Rewrote scheduling functions so that monthly and yearly task run now.
+- Cleaned up significant portions of code base.
[default config](https://github.com/alicereuter/Villefort/blob/master/src/Villefort/Config.hs)
@@ -45,9 +45,10 @@ main = villefort def {
}
}
-
+
+-- description, heading, subject
calendar = pure ["","check calendar","admin"]
-scan = pure ["scan class notes","scan","admin"]
+scan = pure ["scan notes","scan","admin"]
-- | generate increasing sets of push ups
push = do
diff --git a/Villefort.cabal b/Villefort.cabal
index 90bf217..e7a71d4 100644
--- a/Villefort.cabal
+++ b/Villefort.cabal
@@ -1,5 +1,5 @@
name: Villefort
-version: 0.1.2.13
+version: 0.1.2.14
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
@@ -56,6 +56,7 @@ library
, transformers
, MissingH
, convertible
+ , uri-encode
default-language: Haskell2010
@@ -80,12 +81,14 @@ test-suite Villefort-test
main-is: Spec.hs
build-depends: base
, Villefort
+ , concurrent-extra
, hspec
, mtl
, QuickCheck
, HDBC >= 2.4.0 && < 2.5
, HDBC-sqlite3 >= 2.3.3 && < 2.4
, webdriver
+ , unbounded-delays
ghc-options: -threaded -rtsopts -with-rtsopts=-N
@@ -93,4 +96,4 @@ test-suite Villefort-test
source-repository head
type: git
- location: https://github.com/alicereuter/Villefort
+ location: https://github.com/alicereuter/Villefort \ No newline at end of file
diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs
index 548c7ae..b460f53 100644
--- a/src/Villefort/Config.hs
+++ b/src/Villefort/Config.hs
@@ -1,4 +1,4 @@
-module Villefort.Config where
+module Villefort.Config (defaultConfig) where
import Villefort.Definitions (VConfig(..)
, daily
@@ -20,17 +20,17 @@ import Villefort.Definitions (VConfig(..)
, sunday)
-- | Default configuration of VConfig
-def :: VConfig
-def = VConfig {
- daily = [return []], --daily tasks
- monthly =[[]], -- not implemented
- yearly =[[]], -- not implemented
+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
+ port = 3002, -- port number
noCustom = False, -- flag for debugging stops launching custom executable
- showDatabase = False, -- optionally prints database
+ showDatabase = False, -- optionally prints database path
colors = defColors, -- Colors to use first is closest task
- database = [] -- flag for debugging sets database path
+ database = [] -- sets path to database useful to have database in your custom path
}
-- | Default weekly schedule by default is empty
defWeekly :: Weekly
@@ -45,7 +45,14 @@ defWeekly = Weekly {
}
-- | Default colors for Villefort
defColors :: [String]
-defColors = ["#0d47a1","#1565c0","#1976d2","#1e88e5","#2196f3","#42a5f5","#64b5f6","#90caf9"]
+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 5347e4c..16b68c6 100644
--- a/src/Villefort/Daily.hs
+++ b/src/Villefort/Daily.hs
@@ -1,14 +1,19 @@
-{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Daily where
+{-# LANGUAGE FlexibleContexts, UnicodeSyntax #-}
+module Villefort.Daily (dailyCheck ) where
import Villefort.Definitions (VConfig(..)
, Weekly(..))
import Villefort.Database (execQuery, makeQuery, addDaily)
import Control.Monad.Reader (MonadIO,MonadReader,runReaderT,forever,liftIO)
-import Data.List.Split as S (splitOn)
import Control.Concurrent (threadDelay)
-import Villefort.Util
-
+import Villefort.Util (D
+ ,unpackStringToDate
+ ,getDay
+ ,day
+ ,month
+ ,year
+ ,getDate
+ ,getDateD)
-- | writes date to local database
writeDate :: (MonadReader VConfig m, MonadIO m) => m ()
@@ -35,42 +40,17 @@ readDay = do
let int = read (head $ head $ rawDay) :: Int
return int
--- | Checks day equality on two internal date representations
-checkDay :: D -> D ->Bool
-checkDay oldDate currentDate= ((day oldDate) == (day currentDate))
-
--- | Checks month equality on two internal date representations
-checkMonth :: D -> D -> Bool
-checkMonth oldDate currentDate = (month oldDate) == (month currentDate)
-
--- | Checks year equality on two internal date representations
-checkYear :: D -> D -> Bool
-checkYear oldDate currentDate = (year oldDate) == (year currentDate)
--- | Runs daily user defined tasks
-runDaily :: VConfig -> D -> D -> IO ()
-runDaily vconf oldDate currentDate=
- if (checkDay oldDate currentDate) then
+runCheck ∷ Eq x ⇒ VConfig → D → D → (VConfig → [IO [String]]) → (D → x) → String → IO ()
+runCheck vconf oldDate currentDate extract extractInt addText =
+ if notrun then
return ()
- else
- putStrLn "adding-daily" >> do
- dailies <- sequence (daily vconf)
- mapM_ add dailies
- where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) vconf)
-
--- | Runs monthyl user defined tasks TODO
-runMonthly :: D -> D -> IO ()
-runMonthly oldDate currentDate = if(checkMonth oldDate currentDate) then
- putStrLn "same-month"
- else
- putStrLn "adding monthly"
-
--- | Runs yearly user defined tasks TODO
-runYearly :: D -> D -> IO ()
-runYearly oldDate currentDate = if(checkYear oldDate currentDate) then
- putStrLn "same-year"
- else
- putStrLn "adding yearly"
+ 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)
-- | Runs days of the week specific tasks
runWeekly :: VConfig -> Int -> Int -> IO ()
@@ -80,7 +60,7 @@ runWeekly conf old current = do
let stmt = selector conf (current-1)
stmts <- sequence stmt
mapM_ add stmts
- else return ()
+ else putStrLn "didn't run weekly"
where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)
-- | selects correct tasks based on day of the week
@@ -94,23 +74,20 @@ selector conf x
| x == 5 = saturday lookconf
| otherwise = sunday lookconf
where lookconf = weekly conf
-
-
-
-
-man :: VConfig -> IO ()
-man conf = do
- oldDate <- runReaderT readDate conf
+-- | Run daily check for updates
+dailyCheck :: VConfig -> IO ()
+dailyCheck conf = forever $ do
currentDate <- getDateD
+ currentDay <- getDay
+ oldDate <- runReaderT readDate conf
oldDay <- runReaderT readDay conf
- currentDay <- getDay
+ let checkFunc = runCheck conf oldDate currentDate
+ checkFunc daily day "added daily tasks"
+ checkFunc monthly month "added monthly tasks"
+ checkFunc yearly year "added yearly tasks"
runWeekly conf oldDay currentDay
- runDaily conf oldDate currentDate
runReaderT writeDate conf
runReaderT writeDay conf
+ -- check interval
threadDelay 18000000
-
--- | Run daily check for updates
-dailyCheck :: VConfig -> IO b
-dailyCheck conf = forever$ man conf
diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs
index 47816b1..76894d4 100644
--- a/src/Villefort/Database.hs
+++ b/src/Villefort/Database.hs
@@ -1,21 +1,27 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Database where
+module Villefort.Database (makeQuery
+ ,getSubjects
+ ,execQuery
+ ,addDaily
+ ,clean
+ ,getDone
+ ,getDb
+ ,addTask) where
import Control.Monad.Reader (MonadIO,MonadReader,liftIO,ask)
import Database.HDBC.Sqlite3 (Connection,connectSqlite3)
import Database.HDBC (SqlValue
- , execute
- , commit
- , disconnect
- , toSql
- , fromSql
- , quickQuery'
- , prepare)
+ ,execute
+ ,commit
+ ,disconnect
+ ,toSql
+ ,fromSql
+ ,quickQuery'
+ ,prepare)
import System.Environment (getArgs)
import Paths_Villefort (getDataDir)
import Villefort.Definitions (VConfig(..))
import Data.Convertible.Base (Convertible)
-import Data.List.Utils (replace)
-- | gets list of subjects from local database
getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String]
@@ -82,6 +88,7 @@ addTask :: (MonadReader VConfig m, MonadIO m) => String -> String -> String ->
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)]
+
-- | logs new daily entry due on same day
addDaily :: (MonadReader VConfig m, MonadIO m) => [String] -> m ()
addDaily addD= do
@@ -94,4 +101,4 @@ getDone = makeQuery "select Title, time from todo where substr(Due,1,10) = Dat
-- | rudimentary sanitization
clean :: String -> String
-clean = replace "''" "'"
+clean = id
diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs
index 44251af..4bba0ed 100644
--- a/src/Villefort/Definitions.hs
+++ b/src/Villefort/Definitions.hs
@@ -1,10 +1,10 @@
-module Villefort.Definitions where
+module Villefort.Definitions (VConfig (..),Weekly(..)) where
-- | Villefort Configuration data
data VConfig = VConfig {
- daily :: [IO [String]],
- monthly :: [[String]],
- yearly :: [[String]],
+ daily :: [IO [String]],
+ monthly :: [IO [String]],
+ yearly :: [IO [String]],
weekly :: Weekly,
colors :: [String],
port :: Int,
diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs
index c4c13bc..4fbe6e3 100644
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -1,16 +1,15 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Server where
+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
+module Villefort.Server (villefort) where
import Web.Scotty (scotty
- , get
- , html
- , post
- , body
- , redirect
- , html
- , param
- , file)
+ ,get
+ ,html
+ ,post
+ ,body
+ ,redirect
+ ,html
+ ,param
+ ,file)
import Control.Monad.Reader (liftIO,runReaderT)
import Control.Concurrent (forkIO)
import Data.Text.Lazy (pack)
@@ -29,6 +28,7 @@ import System.Process (createProcess,proc,waitForProcess)
import System.Directory (getAppUserDataDirectory,doesFileExist)
import System.Posix.Process (executeFile)
import Data.String.Utils (replace)
+import Network.URI.Encode (decode)
-- | parses value from raw html post form
getIndex :: [[Char]] -> Int -> [Char]
@@ -59,8 +59,7 @@ recompile = do
let execPath = dir ++ "/villefort"
sourcePath = dir ++"/villefort.hs"
(_,_,_,pid) <- createProcess (proc "ghc" ["-o",execPath,sourcePath])
- _ <-
- waitForProcess pid
+ _ <- waitForProcess pid
return ()
-- | checks for executable in villefort home folder if so it executes it
@@ -71,8 +70,8 @@ checkCustomBuild = do
isBuild <- doesFileExist path
dataDir <- getDataDir
if isBuild
- then putStrLn "custom buil detected" >> executeFile path True ["--custom",dataDir] Nothing
- else putStrLn "no custom build :("
+ 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 ()
@@ -105,14 +104,14 @@ launch conf = do
post "/add" $ do
rawBody <-body
let parse = Data.List.Split.splitOn "&" (show rawBody)
- let rep = replace "+" " " . replace "%21" "!" . replace "%40" "@" . replace "%23" "#" . replace "%24" "$" . replace "%25" "%" . replace "%5E" "^" . replace "%26" "&" . replace "%28" "(" . replace "%29" ")" . replace "%2B" "+"
- let summary = rep $ getIndex parse 0
+ let clean = replace "+" " "
+ let summary = clean . decode $ getIndex parse 0
let date = convDate $ getIndex parse 3
- let todoTitle = rep $ getIndex parse 1
- let todoSubject = rep $ getIndex parse 2
+ let todoTitle = clean . decode $ getIndex parse 1
+ let todoSubject = clean . decode $ getIndex parse 2
liftIO $ runReaderT (addTask todoTitle summary date todoSubject) conf
redirect "/"
-
+
get "/today" $ do
dat <-liftIO $ runReaderT getSummary conf
html $ pack dat
diff --git a/src/Villefort/Todo.hs b/src/Villefort/Todo.hs
index a1c56d5..5c1cff3 100644
--- a/src/Villefort/Todo.hs
+++ b/src/Villefort/Todo.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Todo where
+module Villefort.Todo (getTodos,getTheme,subject,updateTodos,deleteTodo) where
import Villefort.Definitions (VConfig(..))
import Villefort.Database (execQuery,getDb)
@@ -159,8 +159,6 @@ getTheme = do
return $ "<style>" ++ (mconcat $ map genSelector mix) ++ "</style>"
where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n background:" ++ (snd x ) ++ "; \n color: #ffffff; }\n"
-
-
-- | Delete a done task from database sets state = 0 but it's record is still maintained in the database for the stats page.
deleteTodo :: (MonadReader VConfig m, MonadIO m) => ByteString -> m ()
deleteTodo raw = do
diff --git a/src/Villefort/Util.hs b/src/Villefort/Util.hs
index 6638b70..2721d49 100644
--- a/src/Villefort/Util.hs
+++ b/src/Villefort/Util.hs
@@ -1,5 +1,13 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Util where
+module Villefort.Util (getHeader
+ ,makeRow
+ ,makeTable
+ ,D(..)
+ ,unpackStringToDate
+ ,getDay
+ ,getDateD
+ ,getDate
+ ,total) where
import Control.Monad.Reader (MonadReader,MonadIO,liftIO)
import Villefort.Definitions (VConfig(..))
@@ -30,13 +38,13 @@ total :: [[String]] -> Int
total row = sum $ map (\x -> read $ x !! 1 :: Int) row
-- | Date representation
-data D = D { year :: Integer,
+data D = D { year :: Int,
month :: Int,
- day :: Int} deriving (Show)
+ day :: Int} deriving (Show)
-- | Convert from string to Day datatype
fromZonedTimeToDay :: String -> Day
-fromZonedTimeToDay x = fromGregorian (year up ) (month up ) (day up)
+fromZonedTimeToDay x = fromGregorian (toInteger (year up) ) (month up ) (day up)
where up = unpackStringToDate x
-- | get Current local time
@@ -49,7 +57,7 @@ getDateD = unpackStringToDate <$> show <$> getZonedTime
-- | convert from String to internal Day representation
unpackStringToDate :: [Char] -> D
-unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)
+unpackStringToDate x = D (read (nums !! 0) :: Int) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)
where nums = S.splitOn "-" $ take 10 x
-- | Get local day of week as number
diff --git a/src/Villefort/Weekly.hs b/src/Villefort/Weekly.hs
index 34f1d6a..67fa6bb 100644
--- a/src/Villefort/Weekly.hs
+++ b/src/Villefort/Weekly.hs
@@ -1,11 +1,11 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Weekly where
+module Villefort.Weekly (weeklyStats) where
import Control.Monad.Reader (MonadIO,MonadReader,liftIO)
import Villefort.Definitions (VConfig(..))
-import Villefort.Util
+import Villefort.Util (getDate,makeTable,getHeader,getDay,total)
import Villefort.Database (makeQuery)
-import Data.Time (Day,addDays,fromGregorian)
+import Data.Time (Day,addDays)
import Data.Time.Calendar.WeekDate (toWeekDate)
import Data.List (nub)
@@ -31,12 +31,6 @@ getStartOfWeek = do
today <- getDate
return $ addDays (-currentDay) today
-
--- | Convert from string to Day datatype
-fromZonedTimeToDay :: String -> Day
-fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up)
- where up = unpackStringToDate x
-
-- | returns the days that have happened this week
getDatesOfWeek :: IO [Day]
getDatesOfWeek = do
diff --git a/test/Spec.hs b/test/Spec.hs
index df4c835..69119b3 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,12 +1,11 @@
import Test.Hspec
import System.Exit (exitFailure)
import Control.Concurrent
+import Control.Concurrent.Thread.Delay (delay)
import Control.Monad.Reader
-import Villefort
import Villefort.Config
import Villefort.Definitions
import Villefort.Database
-import Villefort
import Villefort.Server
import Villefort.Todo
import Database.HDBC.Sqlite3
@@ -17,15 +16,10 @@ import Test.WebDriver
main :: IO ()
main = do
- forkIO (villefort def {port = 999,noCustom = True})
- runSession defaultConfig $ openPage "localhost:999"
-
- {-
hspec $ do
- describe "databse" $ do
- it "does" $ do
+ describe "database" $ do
+ it "does proper inserts" $ do
quickCheckWith args prop_insert
--}
insertTest title des due sub= do
recreate
@@ -44,8 +38,7 @@ prop_insert titl des du su= monadicIO $ do
description=des,
due=du,
subject=su,
- time = 0,
- Villefort.Todo.pred = 0.0})
+ time = 0})
test = def {