Villefort 0.1.2.5 → 0.1.2.6

raw patch · 20 files changed

+375/−294 lines, 20 filesdep +QuickCheckdep +hspecdep +webdriverdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, hspec, webdriver

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• README.md +10/−10
• Villefort.cabal +8/−3
• data/date +1/−1
• data/day +1/−1
• data/todo.db binary
• src/Villefort/Daily.hs +26/−9
• src/Villefort/Database.hs +12/−10
• src/Villefort/Log.hs +82/−0
• src/Villefort/New.hs +27/−0
• src/Villefort/Server.hs +21/−51
• src/Villefort/Stats.hs +0/−89
• src/Villefort/Time.hs +0/−68
• src/Villefort/Today.hs +16/−0
• src/Villefort/Todo.hs +17/−7
• src/Villefort/Util.hs +15/−0
• src/Villefort/Weekly.hs +84/−30
• templates/add.html +0/−8
• templates/header +2/−2
• templates/modal.ts +0/−1
• test/Spec.hs +53/−4

@@ -1,10 +1,10 @@ # Villefort
 Villefort is a time managment system written in Haskell.
 
-## Version 1.2.5
-- Stopped reliance on third party CDN's
-- Escaped 's in todos
-
+## Version 1.2.6
+- Made log github graph reflect actual time on task.
+- removed predicted time field on main page.
+- Started writing tests.
 
 [default config](https://github.com/Chrisr850/Villefort/blob/master/src/Villefort/Config.hs)
 
@@ -36,11 +36,11 @@ 
 main :: IO ()
 main = villefort def {
-  daily = [xcalendar ],
+  daily = [calendar ],
   weekly = defWeekly {
-    monday = [moref],
-    wednesday = [more],
-    friday = [more,
+    monday = [push],
+    wednesday = [push],
+    friday = [push,
               scan]
  
     },
@@ -51,7 +51,7 @@ scan     = pure ["scan class notes","scan","admin"] 
 
 path = "/home/chris/.villefort/push"
-more = do
+push = do
   z <- S.readFile path   -- readfile to get # push ups
   let num = read z :: Double
   writeFile path (show (num+0.3))
@@ -94,7 +94,7 @@ 	|-- js.js
 ```
 Just copy the data/todo.db from the old version into data/todo.db of the new version.
-Remember to rebuild Villefort if you have a custom build to rebuild with the new version.
+Remember to rebuild Villefort if you have a custom build to rebuild with the new villefort.
 
     Villefort --recompile
 

@@ -1,5 +1,5 @@ name:                Villefort-version:             0.1.2.5+version:             0.1.2.6 synopsis: Villefort is a task manager and time tracker written in haskell. description: Villefort is a browser based time tracker. homepage:            https://github.com/Chrisr850/Villefort#readme@@ -32,14 +32,15 @@   exposed-modules:     Villefort                      , Villefort.Todo                      , Villefort.Database-                     , Villefort.Stats-                     , Villefort.Time                      , Villefort.Daily                      , Villefort.Config                      , Villefort.Server                      , Villefort.Util                      , Villefort.Weekly                      , Villefort.Definitions+                     , Villefort.Log+                     , Villefort.New+                     , Villefort.Today   build-depends:       base >= 4.7 && < 5                      , HDBC >= 2.4.0 && < 2.5                      , HDBC-sqlite3 >= 2.3.3 && < 2.4@@ -81,8 +82,12 @@   main-is:             Spec.hs   build-depends:       base                      , Villefort+                     , hspec+                     , mtl+                     , QuickCheck                      , HDBC >= 2.4.0 && < 2.5                      , HDBC-sqlite3 >= 2.3.3 && < 2.4+                     , webdriver                                              ghc-options:         -threaded -rtsopts -with-rtsopts=-N 

@@ -1,1 +1,1 @@-2017-06-05+2018-01-03

@@ -1,1 +1,1 @@-1+3

binary file changed (20480 → 122880 bytes)

@@ -1,23 +1,40 @@ {-# LANGUAGE FlexibleContexts #-} module Villefort.Daily where-import Villefort.Time+--import Villefort.Time import Villefort.Definitions import Villefort.Database-import Villefort.Stats-import Villefort.Todo-import Villefort.Config  import Control.Monad.Reader-import Control.Monad.IO.Class- import Data.Time-import Data.Time.Calendar.WeekDate-import Data.List-import Data.Function+import Data.Time.Calendar.OrdinalDate+import Data.List.Split as S import System.IO.Strict as S import Paths_Villefort import Control.Concurrent (threadDelay)  ++data D = D { year :: Integer,+             month :: Int,+             day :: Int} deriving (Show)++fromZonedTimeToDay :: String -> Day+fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up)+  where up = unpackStringToDate x++getDate :: IO Day+getDate = fromZonedTimeToDay <$> show <$> getZonedTime++getDateD :: IO D+getDateD = unpackStringToDate <$> show <$> getZonedTime++unpackStringToDate :: [Char] -> D+unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)+  where nums = S.splitOn "-" $  take 10 x+  +getDay :: IO Int+getDay = do+  z <- getDate+  return $ snd $mondayStartWeek z  writeDate :: IO () writeDate = do

@@ -16,9 +16,13 @@ type Subject = String  -getSubjects :: (MonadReader VConfig m, MonadIO m) => m [Subject]+--getSubjects :: (MonadReader VConfig m, MonadIO m) => m [Subject]+--getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject"++getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String] getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject" + --path =fmap (\x -> (x !! 0) ++ "Villefort.app/Contents/Resources/") $  (Data.List.Split.splitOn "Villefort.app") <$> getProgPath --path :: IO Path path' ::  (MonadReader VConfig m, MonadIO m) => m FilePath@@ -66,6 +70,9 @@ execQuery query params =  getDb >>= \conn -> liftIO $ prepare conn query >>=   \stmt ->  execute stmt ( map toSql params) >>  commit conn >> disconnect conn ++  + getNextId :: (MonadReader VConfig m, MonadIO m) => m Integer getNextId = do   f <- makeQuery "select id from todo order by id desc"@@ -80,9 +87,9 @@ 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)]-  return ()  + addDaily :: (MonadReader VConfig m, MonadIO m) => [String] -> m () addDaily addD= do   lastRowId <- getNextId@@ -95,15 +102,10 @@   --- | Query to get average of subjects---getAvg :: IO (Maybe [String])-getAvg :: (MonadReader VConfig m, MonadIO m) => m [[String]]-getAvg =  makeQuery "select avg(time), Subject from todo  group by Subject order by avg(time) desc"-+-- | Query to get average of subje -- | Query to get sum of subjects --getSum :: IO (Maybe [String])-getSum :: (MonadReader VConfig m, MonadIO m) => m [[String]]-getSum =  makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"  -clean = replace "'" "''"+clean = id --replace "'" "''"+ 

@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}+module Villefort.Log (genStats) where++import Control.Monad.Reader+import Villefort.Definitions+import Villefort.Database+import Villefort.Util+import Paths_Villefort+import System.Random+import Data.String.Utils (replace)++-- | Generate stats+genStats :: (MonadReader VConfig m, MonadIO m) => m String+genStats = do+  subjects <- getSubjects+  gits <- mapM makeGithub subjects +  avg <- getAvg+  statsSum <- getSum+  x <- liftIO $ getDataFileName "templates/header"+  header <- liftIO (readFile x)+  return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable ["Subject","time"] statsSum) ++ "</html>" ++ (mconcat gits))+++++getAvg :: (MonadReader VConfig m, MonadIO m) => m [[String]]+getAvg =  makeQuery "select avg(time), Subject from todo  group by Subject order by avg(time) desc"++getSum :: (MonadReader VConfig m, MonadIO m) => m [[String]]+getSum =  makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"++  +-- | Library to include for github table+table :: String+table = " <script src='templates/js.js'></script><h1> avg </h1>"++-- | creates the github like graph from database++--makeGithub ::(MonadReader VConfig m, MonadIO m) =>  String ->  m Subject+makeGithub subject1 = do+  let subject = replace "'" "&#39;" subject1+  z <-   makeQuery ("select substr(Due,1,10) from todo where subject = \"" ++ (clean subject) ++ "\" and state = 0 and time!= 0") +  color <- liftIO $  getColor +  let header = "<h2 id='"++ subject ++ "'> Calendar "++ subject ++ " </h2> <script> new Calendar({ append_to: '" ++ subject ++ "',num_weeks: 51,day_size: 11, data: ["+  let q = Prelude.map (\x -> "['" ++ (x !! 0) ++"',500],") z+  let bot = "  ], color: " ++ color ++ " }); </script>"+  return (header ++ (Prelude.concat q )++  bot)++statsColors :: [String]+statsColors = ["'#F44336'"+         ,"'#E91E63'"+         ,"'#9C27B0'"+         ,"'#673AB7'"+         ,"'#3F51B5'"+         ,"'#2196F3'"+         ,"'#03A9F4'"+         ,"'#00BCD4'"+         ,"'#009688'"+         ,"'#4CAF50'"+         ,"'#8BC34A'"+         ,"'#CDDC39'"+         ,"'#FFEB3B'"+         ,"'#FFC107'"+         ,"'#FF9800'"+         ,"'#FF5722'"+         ,"'#795548'"+         ,"'#9E9E9E'"+         ,"'#607D8B'"+         ]+++getColor :: IO String+getColor = do+  number <- randomRIO (0, (length $ statsColors)-1) :: IO Int+  return (statsColors !! number)+  ++getSummary :: (MonadReader VConfig m, MonadIO m) => m String+getSummary = do+  dat <- getDone+  header <-  getHeader+  return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Villefort.New where++import Control.Monad.Reader+import Villefort.Definitions+import System.IO.Strict as S+import Paths_Villefort+import Data.List.Split+import Villefort.Database+++makeNewPage :: (MonadReader VConfig m, MonadIO m) => m String+makeNewPage = do+  headerPath <-liftIO $  getDataFileName "templates/header"+  htmlHeader <- liftIO $ S.readFile headerPath+  addPath <- liftIO $ getDataFileName "templates/add.html"+  add <- liftIO $ S.readFile addPath+  let splitWeeks = splitOn "?" add+  subjects <- getSubjects+  let radiobuttons =  map makeRadio subjects+  return (htmlHeader ++ (splitWeeks !! 0) ++ (concat radiobuttons) ++ (splitWeeks !! 1))+++-- | makes html for radiobutton+makeRadio :: String -> String+makeRadio x =  "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"

@@ -4,37 +4,27 @@  import Web.Scotty import Control.Monad.Reader-import Control.Monad.IO.Class import Control.Concurrent-import Data.List.Split-import Data.Text.Lazy hiding (splitOn,map,concat,head)+import Data.Text.Lazy hiding (splitOn,map,concat,head,replace) import Villefort.Database-import Villefort.Todo-import Villefort.Stats+import Villefort.Todo (deleteTodo,getTodos,updateTodos)+import Villefort.Log import Villefort.Definitions import Villefort.Weekly import Paths_Villefort-import Villefort.Time import Villefort.Daily-import System.IO.Strict as S+import Villefort.New (makeNewPage)+import Villefort.Today+import Data.List.Split import System.Environment-import Control.Monad- import System.Process import System.Directory import System.Posix.Process---getWeeks ::(MonadReader VConfig m,MonadIO m) =>  m [[[Char]]]-getWeeks = do-  rawSql <- makeQuery "select id, Title from weeks where state = 1 order by Title"-  return $ Prelude.mapM (\x -> [Prelude.head x ,( Prelude.tail (Prelude.last x))]) rawSql-+import Data.String.Utils  getIndex :: [[Char]] -> Int -> [Char] getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1 - -- | Converts date from Javascript to sqlite date fromat  convDate :: String -> String convDate date = newDate@@ -42,36 +32,20 @@               newDate = (splitDate !! 2) ++ "-" ++ (splitDate !! 0) ++ "-" ++ (splitDate !! 1)  --- | makes html for radiobutton-makeRadio :: String -> String-makeRadio x =  "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"--makeNewPage :: (MonadReader VConfig m, MonadIO m) => m String-makeNewPage = do-  headerPath <-liftIO $  getDataFileName "templates/header"-  htmlHeader <- liftIO $ S.readFile headerPath-  addPath <- liftIO $ getDataFileName "templates/add.html"-  add <- liftIO $ S.readFile addPath-  let splitWeeks = splitOn "?" add-  subjects <- getSubjects-  let radiobuttons =  map makeRadio subjects-  return (htmlHeader ++ (splitWeeks !! 0) ++ (concat radiobuttons) ++ (splitWeeks !! 1))  --- | Main function of loop---+-- | Entry point for server attempts to  recompile if needed villefort :: VConfig -> IO () villefort conf = do   args <- getArgs   case args of     ["--custom",_] -> putStrLn "custom" >> launch conf      ["--recompile"] -> putStrLn "recompiling" >> recompile-    _ -> putStrLn "straight starting " >> do+    _ -> do       if noCustom conf         then launch conf >> putStrLn "overload"         else checkCustomBuild >> launch conf-+        +-- | recompiles villefort by calling ghc expects .villefort/villefort.hs in home directory recompile :: IO () recompile = do   dir <- getAppUserDataDirectory "villefort"@@ -81,7 +55,8 @@   _ <-     waitForProcess pid   return ()-+  +-- | checks for executable in villefort home folder if so it executes it checkCustomBuild :: IO () checkCustomBuild = do   dir <- getAppUserDataDirectory "villefort"@@ -90,9 +65,10 @@   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 found" +-- | actually launches the scotty server launch :: VConfig -> IO ()     launch conf = do         _ <- forkIO $ dailyCheck conf@@ -119,14 +95,15 @@       let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)       do liftIO $ print rawtime       let insertTime = read (rawtime !! 1) :: Int-      do liftIO $ runReaderT (updateTask sqlId insertTime) conf+      liftIO $ runReaderT (updateTodos sqlId insertTime) conf       redirect "/"      post "/add" $ do       rawBody <-body       let parse = Data.List.Split.splitOn "&" (show rawBody)       do liftIO $ print parse-      let rep y = map (\x -> if x == '+' then ' ' else x) y+      -- !@#$%^&*()_++      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 date    = convDate $ getIndex parse 3       let todoTitle   = rep $ getIndex parse 1@@ -134,16 +111,10 @@       liftIO $ runReaderT (addTask todoTitle summary date todoSubject) conf       redirect "/"   -    get "/time" $ do+    get "/today" $ do       dat <-liftIO $ runReaderT getSummary conf       html $ pack  dat-       -   -    get "/js-chart-widgets.min.js" $ do -     jsPath <- liftIO $  getDataFileName "templates/js.js"-     file jsPath-     get "/templates/:asset" $ do       asset <- param "asset"       path <- liftIO $ getDataFileName $ "templates/" ++ asset@@ -152,9 +123,8 @@     get "/weekly" $ do       to <- liftIO $ runReaderT weeklyStats conf       html $ pack to-       -    get "/stat" $ do+    get "/log" $ do       page <- liftIO $runReaderT  genStats conf       html $ pack page 

@@ -1,89 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-module Villefort.Stats (-  genStats,-  makeTable,-  total,-  getSummary-             )where--import Villefort.Database-import Control.Monad.IO.Class-import Control.Monad.Reader-import Villefort.Definitions-import Villefort.Util-import Paths_Villefort-import System.Random-import Data.List----- | Helper function to generate row of table-makeRow :: [String] -> String-makeRow x =  "<tr> <th>" ++ (intercalate "</th> <th>  "  x )++ "</th> </tr>"---- | Generate Table-makeTable ::[String] ->  [[String]] -> String-makeTable tableData stats = "<table class='table' style='width:100%'> "  ++ "<thead class='thead-inverse'>" ++ ( makeRow  tableData) ++ "</thead>" ++ (mconcat (map  makeRow stats)) ++  "</table>"----- | Generate stats-genStats :: (MonadReader VConfig m, MonadIO m) => m String-genStats = do-  subjects <- getSubjects-  gits <- mapM makeGithub subjects -  avg <- getAvg-  statsSum <- getSum-  x <- liftIO $ getDataFileName "templates/header"-  header <- liftIO (readFile x)-  return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable ["Subject","time"] statsSum) ++ "</html>" ++ (mconcat gits))--  --- | Library to include for github table-table :: String-table = " <script src='/js-chart-widgets.min.js'></script><h1> avg </h1>"---- | creates the github like graph from database--makeGithub ::(MonadReader VConfig m, MonadIO m) =>  String ->  m Subject-makeGithub subject = do-  z <-   makeQuery ("select substr(Due,1,10) from todo where subject = '" ++ (clean subject) ++ "' and state = 0") -  color <- liftIO $  getColor -  let header = "<h2 id='"++ subject ++ "'> Calendar "++ subject ++ " </h2> <script> new Calendar({ append_to: '" ++ subject ++ "',num_weeks: 51,day_size: 11, data: ["-  let q = Prelude.map (\x -> "['" ++ (x !! 0) ++"',500],") z-  let bot = "  ], color: " ++ color ++ " }); </script>"-  return (header ++ (Prelude.concat q )++  bot)--statsColors :: [String]-statsColors = ["'#F44336'"-         ,"'#E91E63'"-         ,"'#9C27B0'"-         ,"'#673AB7'"-         ,"'#3F51B5'"-         ,"'#2196F3'"-         ,"'#03A9F4'"-         ,"'#00BCD4'"-         ,"'#009688'"-         ,"'#4CAF50'"-         ,"'#8BC34A'"-         ,"'#CDDC39'"-         ,"'#FFEB3B'"-         ,"'#FFC107'"-         ,"'#FF9800'"-         ,"'#FF5722'"-         ,"'#795548'"-         ,"'#9E9E9E'"-         ,"'#607D8B'"-         ]--getColor :: IO String-getColor = do-  number <- randomRIO (0, (length $ statsColors)-1) :: IO Int-  return (statsColors !! number)-  -total :: [[String]] -> Int-total row = sum $ map (\x -> read $ x !! 1 :: Int) row--getSummary :: (MonadReader VConfig m, MonadIO m) => m String-getSummary = do-  dat <- getDone-  header <-  getHeader-  return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))

@@ -1,68 +0,0 @@-module Villefort.Time  where--import Data.List.Split as S-import Data.Time-import Data.Time.Calendar.OrdinalDate--data D = D { year :: Integer,-             month :: Int,-             day :: Int} deriving (Show)--fromZonedTimeToDay :: String -> Day-fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up)-  where up = unpackStringToDate x--unpackStringToDate :: [Char] -> D-unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)-  where nums = S.splitOn "-" $  take 10 x-  -  -daysUntil :: [Char] -> IO Integer-daysUntil date = do-  let splits = S.splitOn "-" date-  current <- fromZonedTimeToDay <$> show <$> getZonedTime-  let due     = fromGregorian (read (splits !! 0) :: Integer) (read (splits !! 1) :: Int) (read (splits !! 2) :: Int)-  return $ (diffDays  due current) --getDate :: IO Day-getDate = fromZonedTimeToDay <$> show <$> getZonedTime--getDateD :: IO D-getDateD = unpackStringToDate <$> show <$> getZonedTime--getDay :: IO Int-getDay = do-  z <- getDate-  return $ snd $mondayStartWeek z---getStartOfWeek :: IO Day-getStartOfWeek = do-  currentDay <- toInteger <$> getDay-  today <- getDate-  return $ addDays (-currentDay) today- - -getDatesOfWeek :: IO [Day]-getDatesOfWeek = do-  start <- getStartOfWeek-  currentDay <- getDay-  return $ tail $ take (currentDay+1) $ scanl next start [1,1 .. ]-  where next s x = addDays (x) s---getDatesOfPrevWeek :: IO [Day]-getDatesOfPrevWeek = do-  start <- addDays (-6) <$> getStartOfWeek-  currentDay <- getDay-  return $ [start ,last $ take 7 $ scanl next start [1,1 .. ]]-  where next s   x = addDays (x) s--getDatesOfThisWeek :: IO [Day]-getDatesOfThisWeek = do-  start <- addDays (1) <$> getStartOfWeek-  currentDay <- getDay-  return $ [start ,last $ take (currentDay+1) $ scanl next start [1,1 .. ]]-  where next s   x = addDays (x) s--

@@ -0,0 +1,16 @@+{-# LANGUAGE FlexibleContexts #-}+module Villefort.Today where++import Control.Monad.Reader+import Villefort.Definitions+import Villefort.Database+import Villefort.Util+import Data.List++getSummary :: (MonadReader VConfig m, MonadIO m) => m String+getSummary = do+  dat <- getDone+  header <-  getHeader+  return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))++

@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} module Villefort.Todo  where -import Villefort.Time import Villefort.Definitions import Villefort.Database import Villefort.Util@@ -11,8 +10,20 @@ import Paths_Villefort  import Database.HDBC import Control.Monad.Reader+import Data.List.Split as S+import Data.Time +daysUntil :: [Char] -> IO Integer+daysUntil date = do+  let splits = S.splitOn "-" date+  current <- show <$> getZonedTime+  let due     = fromGregorian (read (splits !! 0) :: Integer) (read (splits !! 1) :: Int) (read (splits !! 2) :: Int)+  let  g = S.splitOn "-" current+  let current = fromGregorian ( read (g  !! 0) :: Integer) (read (g !! 1) :: Int) (read (take 2 ( g !! 2)) :: Int) +  return $ (diffDays  due current)+         + data Row = Row { rid :: Int,                  title :: String,                  description :: String,@@ -20,13 +31,13 @@                  subject :: String,                  time :: Int,                  pred :: Double-               } deriving (Show)+               } deriving (Show,Eq)  toRow :: [String] -> Row toRow x =  Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4)  (read ( x !! 5) :: Int) (read (x !! 6) :: Double) -updateTask :: (MonadReader VConfig m, MonadIO m) => Int -> Int ->  m ()-updateTask sqlId timeTaken = execQuery "insert into todo (id,Description,Title,Entered,Due,state,time,Subject) select id,Description,Title,Entered,datetime('now', 'localtime'),0,?,Subject from todo where id = ? limit 1" [ timeTaken, sqlId]+updateTodos :: (MonadReader VConfig m, MonadIO m) => Int -> Int ->  m ()+updateTodos sqlId timeTaken = execQuery "insert into todo (id,Description,Title,Entered,Due,state,time,Subject) select id,Description,Title,Entered,datetime('now', 'localtime'),0,?,Subject from todo where id = ? limit 1" [ timeTaken, sqlId]  delTask :: (MonadReader VConfig m, MonadIO m) => Int ->  m () delTask sqlId = execQuery "update todo set state = 0 where id = ?" [sqlId]@@ -34,7 +45,7 @@  qetTasks'  :: (MonadReader VConfig m, MonadIO m) => m [Row] qetTasks' = do-  x <- makeQuery' "select id, Title, Description, Due, Subject,  sum(time),pred from todo where state=1 group by id order by Due"+  x <- makeQuery' "select id, Title, Description, Due, Subject,  sum(time), pred from todo where state=1 group by id order by Due"   return (map toRow x)  convRow' :: [[SqlValue]] -> [[String]]@@ -72,7 +83,6 @@             title row,             description row,             show $ time row,-            show $ Villefort.Todo.pred row,             "/delete",             show $ rid row            ]@@ -143,7 +153,7 @@     let sqlId   = read (rawid!! 1) :: Int     let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)     let integerTime = read (rawtime !! 1) :: Int-    do updateTask sqlId integerTime -- update task time+    do updateTodos sqlId integerTime -- update task time     if  integerTime /= 0 then          delTask sqlId  -- then remove from database     else  delTask sqlId -- otherwise just remove from database

@@ -4,8 +4,23 @@ import Control.Monad.Reader import Villefort.Definitions import Paths_Villefort+import Data.List  getHeader :: (MonadReader VConfig m, MonadIO m) => m String getHeader = do   headerPath <- liftIO $ getDataFileName "templates/header"   liftIO $ readFile headerPath+++-- | Helper function to generate row of table+makeRow :: [String] -> String+makeRow x =  "<tr> <th>" ++ (intercalate "</th> <th>  "  x )++ "</th> </tr>"++-- | Generate Table+makeTable ::[String] ->  [[String]] -> String+makeTable tableData stats = "<table class='table' style='width:100%'> "  ++ "<thead class='thead-inverse'>" ++ ( makeRow  tableData) ++ "</thead>" ++ (mconcat (map  makeRow stats)) ++  "</table>"++++total :: [[String]] -> Int+total row = sum $ map (\x -> read $ x !! 1 :: Int) row

@@ -1,37 +1,88 @@ {-# LANGUAGE FlexibleContexts #-}-module Villefort.Weekly where+module Villefort.Weekly (weeklyStats) where  import Control.Monad.Reader import Villefort.Definitions-import Villefort.Time-import Villefort.Stats+--import Villefort.Time (getDatesOfPrevWeek,getDatesOfThisWeek) import Villefort.Util import Villefort.Database-import Data.Time+import Data.Time  import Data.Time.Calendar.WeekDate+import Data.Time.Calendar.OrdinalDate import Data.List+import Data.List.Split as S+{-+unpackStringToDate :: [Char] -> D+unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)+  where nums = S.splitOn "-" $  take 10 x+  -} ++getDatesOfPrevWeek :: IO [Day]+getDatesOfPrevWeek = do+  start <- addDays (-6) <$> getStartOfWeek+  return $ [start ,last $ take 7 $ scanl next start [1,1 .. ]]+  where next s x = addDays (x) s++getDatesOfThisWeek :: IO [Day]+getDatesOfThisWeek = do+  start <- addDays (1) <$> getStartOfWeek+  currentDay <- getDay+  return $ [start ,last $ take (currentDay+1) $ scanl next start [1,1 .. ]]+  where next s x = addDays (x) s+  +getStartOfWeek :: IO Day+getStartOfWeek = do+  currentDay <- toInteger <$> getDay+  today <- getDate+  return $ addDays (-currentDay) today++fromZonedTimeToDay :: String -> Day+fromZonedTimeToDay x = fromGregorian ( y split 0) (md split 1) (md split 2)+  where split = S.splitOn "-" x+        md splits x = read ( splits !! x) :: Int+        y     splits x = read ( splits !! x ) :: Integer++getDate :: IO Day+getDate = fromZonedTimeToDay <$> show <$> getZonedTime++getDay :: IO Int+getDay = do+  z <- getDate+  return $ snd $mondayStartWeek z+  +getDatesOfWeek :: IO [Day]+getDatesOfWeek = do+  start <- getStartOfWeek+  currentDay <- getDay+  return $ tail $ take (currentDay+1) $ scanl next start [1,1 .. ]+  where next s x = addDays (x) s++++ weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String weeklyStats = do   dates<- liftIO getDatesOfWeek   header <-  getHeader   (_,numWeek,_) <- liftIO $ toWeekDate <$> getDate   let addWeek = ( ("<h1> Week " ++ show numWeek ++ "</h1> ") ++ )-  z <-  (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay  dates+  headerdays<-  (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay  dates   d <- genTabs-  return $ z ++ d+  return $ headerdays++ d    getSummaryDay :: (MonadReader VConfig m, MonadIO m) => Day -> m String-getSummaryDay day = do-  dat <- getDoneDay $ show  day-  return ( (lookup !! week) ++  (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))-  where (_,_,week) =  toWeekDate day-        lookup =["","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]+getSummaryDay dayOfweek = do+  dat <- getDoneDay $ show  dayOfweek+  return ( (weeklyDays !! week) ++  (makeTable ["Subject","Time"] $ dat ++ [["Total", show$  total dat]]))+  where (_,_,week) =  toWeekDate dayOfweek+        weeklyDays =["","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]          getPrevWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]] getPrevWeek = do-  z <- liftIO $  getDatesOfPrevWeek-  t z+  dayOfWeek <- liftIO $  getDatesOfPrevWeek+  t dayOfWeek+     where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))  @@ -39,31 +90,32 @@ -- ""2017-11-03" getThisWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]] getThisWeek = do-  z <- liftIO $ getDatesOfThisWeek-  t z+  firstOfWeek<- liftIO $ getDatesOfThisWeek+  t firstOfWeek   where t  = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))  genTabs :: (MonadReader VConfig m, MonadIO m) => m String genTabs = do-  z <- getThisWeek+  datesOfThisWeek <- getThisWeek   t <- getPrevWeek-  return $ makeTable ["Subject","Last week ","This week "] $ n $ spec1 t z+  return $ makeTable ["Subject","Last week ","This week "] $ firstSecond $ spec1 t datesOfThisWeek  getDoneDay :: (MonadReader VConfig m, MonadIO m) =>String -> m [[String]]-getDoneDay day = makeQuery $  "select Title, time  from todo where substr(Due,1,10) = '"++ day ++ "' and time != 0"+getDoneDay queryDay = makeQuery $  "select Title, time  from todo where substr(Due,1,10) = '"++ queryDay ++ "' and time != 0" -spec1 x y = merge1 (fst main) (snd main)-  where set = nub $ map (\x -> x !! 0) $ x ++ y+spec1 :: [[String]] -> [[String]] -> [[String]]+spec1 lastWeek thisWeek = merge1 (fst main) (snd main)+  where set = nub $ map (\x -> x !! 0) $ lastWeek ++ thisWeek         elem1 x y= any (\z -> z !! 0 == x) y-        diff1 = map (\q -> elem1 q x) set-        diff2 = map (\q -> elem1 q y) set-        set1  = zipWithPadding " " [" ","0"] set x-        set2  = zipWithPadding " " [" ","0"] set y-        main = (map (\q -> z (fst q) (snd q) ) $ zip  diff1 set1,-             map (\q -> z (fst q) (snd q) ) $ zip  diff2 set2)+        diff1 = map (\q -> elem1 q lastWeek) set+        diff2 = map (\q -> elem1 q thisWeek) set+        set1  = zipWithPadding " " [" ","0"] set lastWeek+        set2  = zipWithPadding " " [" ","0"] set thisWeek+        main = (map (\q -> selectNum (fst q) (snd q) ) $ zip  diff1 set1,+             map (\q -> selectNum (fst q) (snd q) ) $ zip  diff2 set2) -z :: Bool -> (String,[String]) -> [String]      -z x y  = if x then snd y else [fst y,"0"]+selectNum :: Bool -> (String,[String]) -> [String]      +selectNum x y  = if x then snd y else [fst y,"0"]  zipWithPadding :: a -> b -> [a] -> [b] -> [(a,b)] zipWithPadding a b (x:xs) (y:ys) = (x,y) : zipWithPadding a b xs ys@@ -76,8 +128,10 @@ merge1 (x:xs) (y:ys) = x : y : merge1 xs ys  -n (x:y:xs) = [(x ++ [(y !! 1)])] ++ n xs-n [] = []+firstSecond :: [[String]] -> [[String]]+firstSecond (x:y:xs) = [(x ++ [(y !! 1)])] ++ firstSecond xs+firstSecond [_] = []+firstSecond [] = []  getSubWeek :: (MonadReader VConfig m, MonadIO m) => String -> String -> m [[String]] getSubWeek start end= makeQuery $  "select subject,sum(time) \

@@ -1,14 +1,6 @@   <meta name="viewport" content="width=device-width, initial-scale=1"> -<link rel="stylesheet" href="http://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css">-  <script-  src="https://code.jquery.com/jquery-1.10.2.min.js"-  integrity="sha256-C6CB9UYIS9UJeqinPHWTHVqh/E1uhG5Twh+Y5qFQmYg="-    crossorigin="anonymous"></script>--<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.11.3/jquery.min.js"></script> <script src="https://ajax.googleapis.com/ajax/libs/jqueryui/1.11.4/jquery-ui.min.js"></script>-   <link rel="stylesheet" href="https://ajax.googleapis.com/ajax/libs/jqueryui/1.11.4/themes/smoothness/jquery-ui.css">     <script>   $(document).ready(function() {     $("#due").datepicker();

@@ -25,8 +25,8 @@  <button class="btn btn-primary dropdown-toggle" type="button" data-toggle="dropdown">Stats  	 <span id="i1" class="caret"></span></button>        <ul class="dropdown-menu">-	 <li><a href="/stat"> Log </a> </li>-	 <li><a href="/time"> Today </a> </li>+	 <li><a href="/log"> Log </a> </li>+	 <li><a href="/today"> Today </a> </li> 	 <li><a href="/weekly"> Weekly </a> </li>        </ul> 	</div>

@@ -15,7 +15,6 @@           <p> } </p> 	   	  <p> Total minutes spent working on Project } </p>-	  <p> Predicted time } </p>         </div>         <div class="modal-footer"> 	<form class="pull-left" action="}" method="post" class="add-entry">

@@ -1,9 +1,58 @@-+import Test.Hspec import System.Exit (exitFailure)-import Control.Concurrent +import Control.Concurrent+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+import Database.HDBC hiding (run)+import Test.QuickCheck.Monadic+import Test.QuickCheck+import Test.WebDriver  main :: IO ()-main =  do forkIO (villefort def {port = 999,noCustom = True}) >> do-             putStrLn "started server"+main = do+  forkIO (villefort def {port = 999,noCustom = True})+  runSession  defaultConfig $ openPage "localhost:999" +  {-+  hspec $ do+    describe "databse" $ do+      it "does" $ do+        quickCheckWith args prop_insert+-}++insertTest   title des due sub= do+  recreate+  runReaderT (addTask des title due sub) test+  runReaderT qetTasks' test++args = stdArgs {+  maxSuccess = 1000+  }+  +prop_insert titl des du su= monadicIO $ do+  row <- run $  insertTest titl des du su+  assert ((row !! 0) == Row {+             rid=2,+             title=titl,+             description=des,+             due=du,+             subject=su,+             time = 0,+             Villefort.Todo.pred = 0.0})+           + +test = def {+  database = "test/test.db"+           }++recreate :: IO ()+recreate = do+  runReaderT (execQuery "delete from todo" "") test+  runReaderT (execQuery "insert into todo (id) Values (1)" "") test