diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -1,7 +1,6 @@
module Main where
import Villefort
-import System.Random
main :: IO ()
main = villefort def
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,47 +1,25 @@
# Villefort
Villefort is a time managment system written in Haskell.
-## Version 1.1.13
-You can define your own colors.
-[default config](https://gist.github.com/Chrisr850/3ca20d75c3ac8aaa585c3140e959fdb1)
-
-## How to copy data between versions of Villefort.
-Install the new version through cabal
-Navigate to ~/.cabal
-Navigate to share/
-Navigate into your architecture folder.
-mines x86_64-linux-ghc-7.10.3
-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
+## Version 1.1.14
+Now you can compare new weekly tab.
+Fixed weekly bug.
-| |-- todo.db
+[default config](https://github.com/Chrisr850/Villefort/blob/master/src/Villefort/Config.hs)
-|-- templates/
+# Home screen
+
+# Add new todos
+
+# Stats page
-|-- js.js
+
-Just copy the data/todo.db from the old version into data/todo.db of the new version.
+# To install
+1. Install cabal (https://www.haskell.org/platform/)
+2. In terminal or command prompt run `cabal install Villefort`.
+3. and then `cabal run Villefort`.
+4. You will be able to see the homescreen by typing localhost:3002 into your favorite browser.
## Configure your villefort
create a custom main method in ~.villefort/villefort.hs example
@@ -55,7 +33,7 @@
main :: IO ()
main = villefort def {
-- description Title Subject
- daily = [[ "Water Plants with 50ml of water","Water Plants","Garden"]] -- tasks to run daily
+ daily = [[ "","check calendar","admin"]] -- tasks to run daily
weekly = defWeekly {
friday = [return ["Freaky Friday","Friday","Admin"] -- tasks to run every friday
},
@@ -68,16 +46,34 @@
The default configuration is located here https://github.com/Chrisr850/Villefort/blob/master/src/Villefort/Config.hs
-# Home screen
-
-# Add new todos
-
-# Stats page
-
+## How to copy data between versions of Villefort.
+Install the new version through cabal
+Navigate to ~/.cabal
+Navigate to share/
+Navigate into your architecture folder mines x86_64-linux-ghc-7.10.3
+You should now see different versions of Villefort
-# To install
-1. Install cabal (https://www.haskell.org/platform/)
-2. In terminal or command prompt run `cabal install Villefort`.
-3. and then `cabal run Villefort`.
-4. You will be able to see the homescreen by typing localhost:3002 into your favorite browser.
+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.
+Then remember to rebuild Villefort if you have a custom build.
+
+ Villefort --recompile
+
diff --git a/Villefort.cabal b/Villefort.cabal
--- a/Villefort.cabal
+++ b/Villefort.cabal
@@ -1,5 +1,5 @@
name: Villefort
-version: 0.1.1.13
+version: 0.1.1.14
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
@@ -3,6 +3,7 @@
import System.Process
import Villefort.Definitions
import Villefort.Database
+
def = VConfig {
daily = [[]], --daily tasks
monthly =[[]], -- not implemented
@@ -11,7 +12,8 @@
port = 3002, -- port
noCustom = False, -- flag for debugging stops launching custom executable
showDatabase = False, -- optionally prints database
- colors = defColors -- Colors to use first is closest task
+ colors = defColors, -- Colors to use first is closest task
+ database = [] -- flag for debugging sets database path
}
defWeekly = Weekly {
@@ -25,4 +27,4 @@
}
defColors = ["#0d47a1","#1565c0","#1976d2","#1e88e5","#2196f3","#42a5f5","#64b5f6","#90caf9"]
--- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.xx
+-- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.\
diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs
--- a/src/Villefort/Daily.hs
+++ b/src/Villefort/Daily.hs
@@ -11,6 +11,8 @@
import Control.Monad.IO.Class
import Data.Time
import Data.Time.Calendar.WeekDate
+import Data.List
+import Data.Function
weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String
weeklyStats = do
@@ -18,14 +20,48 @@
header <- getHeader
(_,numWeek,_) <- liftIO $ toWeekDate <$> getDate
let addWeek = ( (" Week " ++ show numWeek ++ "
") ++ )
- (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay dates
+ z <- (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay dates
+ d <- n
+ return $ z ++ d
getSummaryDay :: (MonadReader VConfig m, MonadIO m) => Day -> m String
getSummaryDay day = do
- liftIO $ putStrLn $ show day
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"]
-
+ lookup =["","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"]
+
+st :: (MonadReader VConfig m, MonadIO m) => m [[String]]
+st = do
+ z <- liftIO $ getDatesOfPrevWeek
+ t z
+ where t = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))
+
+p :: (MonadReader VConfig m, MonadIO m) => m [[String]]
+p = do
+ z <- liftIO $ getDatesOfThisWeek
+ t z
+ where t = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))
+
+n :: (MonadReader VConfig m, MonadIO m) => m String
+n = do
+ z <- p
+ t <- st
+ let q = sortBy ( compare `on` head) $ z ++ t
+
+ return $ makeTable ["Subject","Last week","This week"] $ spec q
+
+
+spec :: [[String]] -> [[String]]
+spec (x:y:z) = if head x == head y
+ then [[head x] ++ tail x ++ tail y] ++ spec (y:z)
+ else spec (y:z)
+
+spec (x:y:[]) = if head x == (head y)
+ then [[head x], tail x ++ (tail y)] ++ spec [y]
+ else spec [y]
+
+spec (x:[]) = [x]
+spec [] = []
+
diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs
--- a/src/Villefort/Database.hs
+++ b/src/Villefort/Database.hs
@@ -19,7 +19,6 @@
--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
path' = do
env <- ask
@@ -34,12 +33,14 @@
if s then (liftIO $ putStrLn =<< getDataDir) >> cont else cont
getDb :: (MonadReader VConfig m, MonadIO m) => m Connection
---getDb = (++ "/data/todo.db") <$> liftIO path' >>= \path -> liftIO $ connectSqlite3 path
-
getDb = do
- path <- path'
- let fullpath = (path ++ "/data/todo.db")
- liftIO $ connectSqlite3 fullpath
+ env <- ask
+ let dat = database env
+ let isDat = not $ null $ dat
+ if isDat then liftIO $ connectSqlite3 dat else do
+ path <- path'
+ let fullpath = (path ++ "/data/todo.db")
+ liftIO $ connectSqlite3 fullpath
--convRow :: [[SqlValue]] -> [[String]]
convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat
@@ -106,3 +107,10 @@
--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"
+
+getSubWeek :: (MonadReader VConfig m, MonadIO m) => String -> String -> m [[String]]
+getSubWeek start end= makeQuery $ "select subject,sum(time) \
+ \ from todo where \
+ \ substr(entered,1,10) >= '" ++ start ++"' \
+ \and substr(entered,1,10) <= '"++ end ++ "' \
+ \group by subject "
diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs
--- a/src/Villefort/Definitions.hs
+++ b/src/Villefort/Definitions.hs
@@ -8,7 +8,8 @@
colors :: [String],
port :: Int,
noCustom :: Bool,
- showDatabase :: Bool
+ showDatabase :: Bool,
+ database :: String
}
data Weekly = Weekly {
diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -237,10 +237,14 @@
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 "/arst" $ do
+ z <- liftIO $ runReaderT n conf
+ html $ pack z
get "/stat" $ do
page <- liftIO $runReaderT genStats conf
diff --git a/src/Villefort/Stats.hs b/src/Villefort/Stats.hs
--- a/src/Villefort/Stats.hs
+++ b/src/Villefort/Stats.hs
@@ -9,11 +9,11 @@
import Villefort.Definitions
import Paths_Villefort
import System.Random
-
+import Data.List
-- | Helper function to generate row of table
makeRow :: [String] -> String
-makeRow x = " | " ++ (x !! 0) ++ " | " ++ (x!! 1) ++ " |
"
+makeRow x = " | " ++ (intercalate " | " x )++ " |
"
-- | Generate Table
makeTable ::[String] -> [[String]] -> String
diff --git a/src/Villefort/Time.hs b/src/Villefort/Time.hs
--- a/src/Villefort/Time.hs
+++ b/src/Villefort/Time.hs
@@ -19,14 +19,15 @@
daysUntil :: [Char] -> IO Integer
daysUntil date = do
- let split = S.splitOn "-" date
+ let splits = S.splitOn "-" date
current <- fromZonedTimeToDay <$> show <$> getZonedTime
- let due = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (split !! 2) :: Int)
+ 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
@@ -46,5 +47,22 @@
getDatesOfWeek = do
start <- getStartOfWeek
currentDay <- getDay
- return $ take currentDay $ scanl next start [1,1 .. ]
- where next day x = addDays (x) day
+ 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 (currentDay+2) $ 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+2) $ scanl next start [1,1 .. ]]
+ where next s x = addDays (x) s
+
+