diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,10 +1,9 @@
# Villefort
Villefort is a time managment system written in Haskell.
-## Version 1.1.6
-Now has
--- accurate due rankings
--- total on today page
+## Version 1.1.11
+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
diff --git a/Villefort.cabal b/Villefort.cabal
--- a/Villefort.cabal
+++ b/Villefort.cabal
@@ -1,5 +1,5 @@
name: Villefort
-version: 0.1.1.10
+version: 0.1.1.11
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
@@ -4,13 +4,14 @@
import Villefort.Definitions
import Villefort.Database
def = VConfig {
- daily = [[]],
- monthly =[[]],
- yearly =[[]],
- weekly = defWeekly,
- port = 3002,
- noCustom = False,
- showDatabase = False
+ daily = [[]], --daily tasks
+ monthly =[[]], -- not implemented
+ yearly =[[]], -- not implemented
+ weekly = defWeekly, -- tasks to run on a given week day
+ 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
}
defWeekly = Weekly {
@@ -23,4 +24,5 @@
sunday = [return []]
}
--- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.hs
+defColors = ["#0d47a1","#1565c0","#1976d2","#1e88e5","#2196f3","#42a5f5","#64b5f6","#90caf9"]
+-- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.s
diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs
--- a/src/Villefort/Definitions.hs
+++ b/src/Villefort/Definitions.hs
@@ -5,9 +5,9 @@
monthly :: [[String]],
yearly :: [[String]],
weekly :: Weekly,
+ colors :: [String],
port :: Int,
noCustom :: Bool,
- dataBasePath :: Maybe String,
showDatabase :: Bool
}
@@ -20,5 +20,3 @@
saturday :: [IO[String]],
sunday ::[IO[String]]
}
-
-
diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -12,7 +12,6 @@
import Villefort.Stats
import Villefort.Definitions
import Paths_Villefort
-import Villefort.Daily
import Villefort.Ml
import Villefort.Time
import Villefort.Summary
@@ -22,9 +21,8 @@
import Control.Monad.Reader
import System.Process
import System.Directory
-import System.FilePath
import System.Posix.Process
-import Paths_Villefort
+
getWeeks ::(MonadReader VConfig m,MonadIO m) => m [[[Char]]]
getWeeks = do
rawSql <- makeQuery "select id, Title from weeks where state = 1 order by Title"
@@ -71,21 +69,21 @@
readDate :: IO D
readDate = do
datePath <- getDataFileName "data/date"
- raw <- S.readFile datePath
- let date = unpackStringToDate raw
+ rawDate <- S.readFile datePath
+ let date = unpackStringToDate rawDate
return date
writeDay :: IO ()
writeDay = do
- day <- show <$> getDay
+ newDay <- show <$> getDay
datePath <- getDataFileName "data/day"
- writeFile datePath day
+ writeFile datePath newDay
readDay :: IO Int
readDay = do
datePath <- getDataFileName "data/day"
- raw <- S.readFile datePath
- let int = read raw :: Int
+ rawDay <- S.readFile datePath
+ let int = read rawDay :: Int
return int
checkDay :: D -> D ->Bool
@@ -95,6 +93,7 @@
checkYear :: D -> D -> Bool
checkYear oldDate currentDate = (year oldDate) == (year currentDate)
+runDaily :: VConfig -> D -> D -> IO ()
runDaily vconf oldDate currentDate=
if (checkDay oldDate currentDate) then
putStrLn "same-day"
@@ -123,22 +122,24 @@
mapM_ add stmts
else return ()
where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)
-
+
+selector :: (Num a, Eq a) => VConfig -> a -> [IO [String]]
selector conf x
- | x == 0 = monday lookup
- | x == 1 = tuesday lookup
- | x == 2 = wednesday lookup
- | x == 3 = thursday lookup
- | x == 4 = friday lookup
- | x == 5 = saturday lookup
- | otherwise = sunday lookup
- where lookup = weekly conf
+ | x == 0 = monday lookconf
+ | x == 1 = tuesday lookconf
+ | x == 2 = wednesday lookconf
+ | x == 3 = thursday lookconf
+ | x == 4 = friday lookconf
+ | x == 5 = saturday lookconf
+ | otherwise = sunday lookconf
+ where lookconf = weekly conf
--man :: IO ()
+man :: VConfig -> IO ()
man conf = do
oldDate <- readDate
currentDate <- getDateD
@@ -150,13 +151,14 @@
writeDay
threadDelay 18000000
-
+dailyCheck :: VConfig -> IO b
dailyCheck conf = forever$ man conf
+villefort :: VConfig -> IO ()
villefort conf = do
args <- getArgs
case args of
- ["--custom",x] -> putStrLn "custom" >> launch conf
+ ["--custom",_] -> putStrLn "custom" >> launch conf
["--recompile"] -> putStrLn "recompiling" >> recompile
_ -> putStrLn "straight starting " >> do
if noCustom conf
@@ -169,10 +171,11 @@
let execPath = dir ++ "/villefort"
sourcePath = dir ++"/villefort.hs"
(_,_,_,pid) <- createProcess (proc "/usr/bin/ghc" ["-o",execPath,sourcePath])
- waitForProcess pid
+ _ <-
+ waitForProcess pid
return ()
-
checkCustomBuild = do
+
dir <- getAppUserDataDirectory "villefort"
let path = dir ++ "/villefort"
putStrLn path
diff --git a/src/Villefort/Stats.hs b/src/Villefort/Stats.hs
--- a/src/Villefort/Stats.hs
+++ b/src/Villefort/Stats.hs
@@ -47,8 +47,8 @@
let bot = " ], color: " ++ color ++ " }); "
return (header ++ (Prelude.concat q )++ bot)
-colors :: [String]
-colors = ["'#F44336'"
+statsColors :: [String]
+statsColors = ["'#F44336'"
,"'#E91E63'"
,"'#9C27B0'"
,"'#673AB7'"
@@ -71,6 +71,6 @@
getColor :: IO String
getColor = do
- number <- randomRIO (0, (length $ colors)-1) :: IO Int
- return (colors !! number)
+ number <- randomRIO (0, (length $ statsColors)-1) :: IO Int
+ return (statsColors !! number)
diff --git a/src/Villefort/Summary.hs b/src/Villefort/Summary.hs
--- a/src/Villefort/Summary.hs
+++ b/src/Villefort/Summary.hs
@@ -7,12 +7,12 @@
import Villefort.Definitions
f :: [[String]] -> Int
-f x = sum $ map (\x -> read $ x !! 1 :: Int) x
+f row = sum $ map (\x -> read $ x !! 1 :: Int) row
getSummary :: (MonadReader VConfig m, MonadIO m) => m String
getSummary = do
dat <- getDone
- header <- liftIO $ getHeader
+ header <- getHeader
return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$ f dat]]))
--2017-07-26
diff --git a/src/Villefort/Todo.hs b/src/Villefort/Todo.hs
--- a/src/Villefort/Todo.hs
+++ b/src/Villefort/Todo.hs
@@ -6,7 +6,7 @@
import Villefort.Definitions
import Control.Monad.IO.Class
import Data.List.Split
-import Data.ByteString.Lazy hiding (map,length,take,readFile)
+import Data.ByteString.Lazy hiding (map,length,take,readFile,zip)
import Paths_Villefort
import Database.HDBC
import Control.Monad.Reader
@@ -110,17 +110,25 @@
getTodos :: (MonadReader VConfig m, MonadIO m) => m String
getTodos = do
tasks <- qetTasks'
- --do liftIO $ putStrLn $ show tasks
modals <-liftIO $ sequence $ genModal' <$> tasks
- header <- liftIO $ getHeader
+ header <- getHeader
+ theme <- getTheme
let body = Prelude.concat modals
- return (header ++ body)
+ return (header ++ theme ++ body)
-getHeader :: IO String
+getTheme :: (MonadReader VConfig m, MonadIO m) => m String
+getTheme = do
+ userConfig <- ask
+ let userColor = colors userConfig
+ let mix = zip [0 ..] userColor
+ return $ ""
+ where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n background:" ++ (snd x ) ++ "; \n color: #ffffff; }\n"
+
+
+getHeader :: (MonadReader VConfig m, MonadIO m) => m String
getHeader = do
- headerPath <-getDataFileName "templates/header"
- header <- liftIO $ readFile headerPath
- return header
+ headerPath <- liftIO $ getDataFileName "templates/header"
+ liftIO $ readFile headerPath
-- | Delete a done task from database sets state = 0 but it's record is still maintained in the database for the stats page.
diff --git a/templates/header b/templates/header
--- a/templates/header
+++ b/templates/header
@@ -7,41 +7,15 @@
-
+
+
+
+
+
+ >
Villefort
@@ -67,19 +41,13 @@
-
-
+
-
-
-
+