Villefort 0.1.2.13 → 0.1.2.14

raw patch · 13 files changed

+123/−137 lines, 13 filesdep +concurrent-extradep +unbounded-delaysdep +uri-encodePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: concurrent-extra, unbounded-delays, uri-encode

API changes (from Hackage documentation)

Files

• LICENSE +2/−2
• Main.hs +3/−4
• README.md +6/−5
• Villefort.cabal +4/−1
• src/Villefort/Config.hs +17/−10
• src/Villefort/Daily.hs +30/−53
• src/Villefort/Database.hs +17/−10
• src/Villefort/Definitions.hs +4/−4
• src/Villefort/Server.hs +19/−20
• src/Villefort/Todo.hs +1/−3
• src/Villefort/Util.hs +13/−5
• src/Villefort/Weekly.hs +3/−9
• test/Spec.hs +4/−11

@@ -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. 

@@ -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

@@ -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

@@ -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 

@@ -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"]   

@@ -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

@@ -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

@@ -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,

@@ -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

@@ -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 $ "<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

@@ -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

@@ -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]

@@ -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 {