diff --git a/LICENSE b/LICENSE --- 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 @@ 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 --- 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 --- 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 @@ } } - + +-- 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 --- 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 @@ , transformers , MissingH , convertible + , uri-encode default-language: Haskell2010 @@ -80,12 +81,14 @@ 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 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 where +module Villefort.Config (defaultConfig) where import Villefort.Definitions (VConfig(..) , daily @@ -20,17 +20,17 @@ , 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 @@ } -- | 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 --- 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 @@ 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 @@ 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 @@ | 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 --- 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 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 @@ -- | rudimentary sanitization clean :: String -> String -clean = replace "''" "'" +clean = id diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs --- 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 --- 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.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 @@ 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 @@ 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 @@ 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 --- 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 @@ return $ "" 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 --- 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 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 @@ -- | 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 --- 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) @@ -30,12 +30,6 @@ currentDay <- toInteger <$> getDay 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] diff --git a/test/Spec.hs b/test/Spec.hs --- 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 @@ 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 @@ description=des, due=du, subject=su, - time = 0, - Villefort.Todo.pred = 0.0}) + time = 0}) test = def {