diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -14,19 +14,31 @@
You should now see the two versions of Villefort
Villefort-0.1.1.0/
+
|-- data/
+
| |-- date
+
| |-- day
+
| |-- todo.db
+
|-- templates/
+
|-- js.js
Villefort-0.1.1.1/
+
|-- data/
+
| |-- date
+
| |-- day
+
| |-- todo.db
+
|-- templates/
+
|-- js.js
Just copy the data/todo.db from the old version into data/todo.db of the new version.
diff --git a/Villefort.cabal b/Villefort.cabal
--- a/Villefort.cabal
+++ b/Villefort.cabal
@@ -1,5 +1,5 @@
name: Villefort
-version: 0.1.1.11
+version: 0.1.1.12
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
diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs
--- a/src/Villefort/Config.hs
+++ b/src/Villefort/Config.hs
@@ -25,4 +25,4 @@
}
defColors = ["#0d47a1","#1565c0","#1976d2","#1e88e5","#2196f3","#42a5f5","#64b5f6","#90caf9"]
--- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.s
+-- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.xx
diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs
--- a/src/Villefort/Daily.hs
+++ b/src/Villefort/Daily.hs
@@ -1,7 +1,30 @@
+{-# LANGUAGE FlexibleContexts #-}
module Villefort.Daily where
import Villefort.Time
+import Villefort.Definitions
import Villefort.Database
-import Control.Concurrent
-import Control.Monad
-import System.IO.Strict as S
-import Paths_Villefort
+import Villefort.Stats
+import Villefort.Todo
+import Villefort.Summary
+import Villefort.Config
+import Control.Monad.Reader
+import Control.Monad.IO.Class
+import Data.Time
+import Data.Time.Calendar.WeekDate
+
+weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String
+weeklyStats = do
+ dates<- liftIO getDatesOfWeek
+ header <- getHeader
+ (_,numWeek,_) <- liftIO $ toWeekDate <$> getDate
+ let addWeek = ( (" Week " ++ show numWeek ++ "
") ++ )
+ (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay dates
+
+
+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 =["","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday","Monday"]
+
diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs
--- a/src/Villefort/Database.hs
+++ b/src/Villefort/Database.hs
@@ -92,6 +92,11 @@
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"
+
+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"
+
+
-- | Query to get average of subjects
--getAvg :: IO (Maybe [String])
getAvg :: (MonadReader VConfig m, MonadIO m) => m [[String]]
diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -15,6 +15,7 @@
import Villefort.Ml
import Villefort.Time
import Villefort.Summary
+import Villefort.Daily
import System.IO.Strict as S
import System.Environment
import Control.Monad
@@ -230,12 +231,16 @@
get "/time" $ do
dat <-liftIO $ runReaderT getSummary conf
html $ pack dat
-
-
+
+
- get "/js-chart-widgets.min.js" $ do
- jsPath <- liftIO $ getDataFileName "js.js"
- file jsPath
+ get "/js-chart-widgets.min.js" $ do
+ jsPath <- liftIO $ getDataFileName "js.js"
+ file jsPath
+
+ get "/weekly" $ do
+ to <- liftIO $ runReaderT weeklyStats conf
+ html $ pack to
get "/stat" $ do
page <- liftIO $runReaderT genStats conf
diff --git a/src/Villefort/Summary.hs b/src/Villefort/Summary.hs
--- a/src/Villefort/Summary.hs
+++ b/src/Villefort/Summary.hs
@@ -6,13 +6,11 @@
import Villefort.Stats
import Villefort.Definitions
-f :: [[String]] -> Int
-f row = sum $ map (\x -> read $ x !! 1 :: Int) row
+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$ f dat]]))
-
---2017-07-26
+ return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$ total dat]]))
diff --git a/src/Villefort/Time.hs b/src/Villefort/Time.hs
--- a/src/Villefort/Time.hs
+++ b/src/Villefort/Time.hs
@@ -11,15 +11,14 @@
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
- c <- getCurrentTime
- let (y,m,d) = toGregorian $ utctDay c
let split = S.splitOn "-" date
current <- fromZonedTimeToDay <$> show <$> getZonedTime
let due = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (split !! 2) :: Int)
@@ -34,3 +33,18 @@
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 $ take currentDay $ scanl next start [1,1 .. ]
+ where next day x = addDays (x) day
diff --git a/templates/header b/templates/header
--- a/templates/header
+++ b/templates/header
@@ -15,7 +15,6 @@
integrity="sha256-C6CB9UYIS9UJeqinPHWTHVqh/E1uhG5Twh+Y5qFQmYg="
crossorigin="anonymous">
- >
Villefort
@@ -30,13 +29,23 @@
+
+
+
-
+
+
+
+
@@ -54,3 +63,4 @@
});
+