summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAliceReuter <>2018-07-05 19:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-07-05 19:45:00 (GMT)
commit3914cef5dbdf12c1f96b520ad34efa9c2bd372f7 (patch)
tree0f615bb0de1bc518588fe678a1e15dcb0c136c55
parent2bdf12d929351b0b5d42e5f6fb148eb1e7357497 (diff)
version 0.1.2.130.1.2.13
-rw-r--r--README.md37
-rw-r--r--Villefort.cabal8
-rw-r--r--src/Villefort.hs1
-rw-r--r--src/Villefort/Config.hs31
-rw-r--r--src/Villefort/Daily.hs58
-rw-r--r--src/Villefort/Database.hs102
-rw-r--r--src/Villefort/Definitions.hs2
-rw-r--r--src/Villefort/Log.hs32
-rw-r--r--src/Villefort/New.hs17
-rw-r--r--src/Villefort/Server.hs53
-rw-r--r--src/Villefort/Today.hs12
-rw-r--r--src/Villefort/Todo.hs84
-rw-r--r--src/Villefort/Util.hs45
-rw-r--r--src/Villefort/Weekly.hs71
-rw-r--r--templates/modal.ts4
15 files changed, 287 insertions, 270 deletions
diff --git a/README.md b/README.md
index 905e7a5..b3557d6 100644
--- a/README.md
+++ b/README.md
@@ -1,9 +1,10 @@
# Villefort
Villefort is a time management system written in Haskell.
-## Version 1.2.12
+## Version 1.2.13
- Integrated date and day tracking into database to stop file corruption.
+
[default config](https://github.com/alicereuter/Villefort/blob/master/src/Villefort/Config.hs)
# Home screen
@@ -27,32 +28,32 @@ create a custom main method in ~.villefort/villefort.hs. Below is an example.
```haskell
module Main where
-import Villefort
+import Villefort.Server
+import Villefort.Config
import Villefort.Definitions
import System.Random
import System.IO.Strict as S
main :: IO ()
main = villefort def {
- daily = [xcalendar ],
+ daily = [calendar ],
weekly = defWeekly {
- monday = [moref],
- wednesday = [more],
- friday = [more,
+ monday = [push],
+ wednesday = [push],
+ friday = [push,
scan]
- },
- showDatabase = True
+ }
}
calendar = pure ["","check calendar","admin"]
scan = pure ["scan class notes","scan","admin"]
--- | functionally generate increasing sets of push ups
-more = do
- z <- S.readFile path -- readfile to get # push ups
- let num = read z :: Double
- writeFile path (show (num+0.3))
+-- | generate increasing sets of push ups
+push = do
+ rawNum <- S.readFile "push" -- readfile to get # push ups
+ let num = read rawNum :: Double
+ writeFile "push" (show (num+0.3))
sets <- pushUps num
return $ [show sets,"push ups","fit"]
@@ -63,8 +64,8 @@ pushUps level = do
```
-Then run ```Villefort --recompile```
-the next time you run villefort it will run with your configuration. The default Config is found in Villefort.Config.
+Use ```Villefort --recompile``` to recompile Villefort with your custom config. Recompilation requires ghc to be in your $PATH.
+The next time you run villefort it will run with your custom config. The default Config is found in Villefort.Config.
## How to copy data between versions of Villefort.
1. Install the new version through cabal.
@@ -73,7 +74,7 @@ the next time you run villefort it will run with your configuration. The default
4. Navigate into your architecture folder mine is x86_64-linux-ghc-7.10.3.
5. You should now see different versions of Villefort.
-Villefort-0.1.1.0/
+Villefort-0.1.2.12/
```
|-- data/
| |-- date
@@ -82,7 +83,7 @@ Villefort-0.1.1.0/
|-- templates/
|-- js.js
```
-Villefort-0.1.1.1/
+Villefort-0.1.2.13/
```
|-- data/
| |-- date
@@ -92,7 +93,7 @@ Villefort-0.1.1.1/
|-- 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 so that your custom build uses the new version of Villefort.
Villefort --recompile
diff --git a/Villefort.cabal b/Villefort.cabal
index cdebed9..90bf217 100644
--- a/Villefort.cabal
+++ b/Villefort.cabal
@@ -1,5 +1,5 @@
name: Villefort
-version: 0.1.2.12
+version: 0.1.2.13
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
@@ -27,8 +27,7 @@ library
hs-source-dirs: src
other-modules: Paths_Villefort
ghc-options: -Wall
- exposed-modules: Villefort
- , Villefort.Todo
+ exposed-modules: Villefort.Todo
, Villefort.Database
, Villefort.Daily
, Villefort.Config
@@ -55,7 +54,8 @@ library
, unix
, bytestring
, transformers
- , MissingH
+ , MissingH
+ , convertible
default-language: Haskell2010
diff --git a/src/Villefort.hs b/src/Villefort.hs
deleted file mode 100644
index e0d874c..0000000
--- a/src/Villefort.hs
+++ /dev/null
@@ -1 +0,0 @@
-module Villefort where
diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs
index 4b8f7e2..548c7ae 100644
--- a/src/Villefort/Config.hs
+++ b/src/Villefort/Config.hs
@@ -1,7 +1,24 @@
module Villefort.Config where
-import Villefort.Definitions
-
+import Villefort.Definitions (VConfig(..)
+ , daily
+ , monthly
+ , yearly
+ , weekly
+ , port
+ , noCustom
+ , showDatabase
+ , colors
+ , database
+ , Weekly(..)
+ , monday
+ , tuesday
+ , wednesday
+ , thursday
+ , friday
+ , saturday
+ , sunday)
+
-- | Default configuration of VConfig
def :: VConfig
def = VConfig {
@@ -29,3 +46,13 @@ defWeekly = Weekly {
-- | Default colors for Villefort
defColors :: [String]
defColors = ["#0d47a1","#1565c0","#1976d2","#1e88e5","#2196f3","#42a5f5","#64b5f6","#90caf9"]
+
+
+
+
+
+
+
+
+
+
diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs
index 162652d..5347e4c 100644
--- a/src/Villefort/Daily.hs
+++ b/src/Villefort/Daily.hs
@@ -1,66 +1,53 @@
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Daily where
-import Villefort.Definitions
-import Villefort.Database
-import Control.Monad.Reader
-import Data.Time
-import Data.Time.Calendar.OrdinalDate
-import Data.List.Split as S
-import Control.Concurrent (threadDelay)
-
--- | Date representation
-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
+
+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
+-- | writes date to local database
writeDate :: (MonadReader VConfig m, MonadIO m) => m ()
writeDate = do
date <- liftIO $ show <$> getDate
execQuery ("update dates set date = ? where type = 'date';") [date]
+-- | reads date from local database
readDate :: (MonadReader VConfig m, MonadIO m) => m D
readDate = do
rawDate <- makeQuery "select date from dates where type = 'date';"
return $ unpackStringToDate $ head $ head $ rawDate
+-- | writes day of week from local database
writeDay :: (MonadReader VConfig m, MonadIO m) => m ()
writeDay = do
newDay <- liftIO $ show <$> getDay
execQuery ("update dates set date = ? where type = 'day';") [newDay]
-
+
+-- | read day of week from local database
readDay :: (MonadReader VConfig m, MonadIO m) => m Int
readDay = do
rawDay <- makeQuery "select date from dates where type = 'day';"
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
@@ -71,19 +58,21 @@ runDaily vconf oldDate currentDate=
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"
+-- | Runs days of the week specific tasks
runWeekly :: VConfig -> Int -> Int -> IO ()
runWeekly conf old current = do
if old /= current
@@ -94,6 +83,7 @@ runWeekly conf old current = do
else return ()
where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)
+-- | selects correct tasks based on day of the week
selector :: (Num a, Eq a) => VConfig -> a -> [IO [String]]
selector conf x
| x == 0 = monday lookconf
diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs
index 5c030eb..47816b1 100644
--- a/src/Villefort/Database.hs
+++ b/src/Villefort/Database.hs
@@ -1,30 +1,27 @@
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Database where
-import Control.Monad.IO.Class
-import Control.Monad.Reader
-import Database.HDBC.Sqlite3
-import Database.HDBC
-import Data.List.Split
-import System.Environment
-import Paths_Villefort
-import Villefort.Definitions
-import Data.String.Utils
-
-type Query = String
-type Path = String
-type Subject = String
-
-
---getSubjects :: (MonadReader VConfig m, MonadIO m) => m [Subject]
---getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject"
-
+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)
+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]
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
+-- | get paths tests for --custom flag to allow for executing custom builds
path' :: (MonadReader VConfig m, MonadIO m) => m FilePath
path' = do
env <- ask
@@ -37,7 +34,9 @@ path' = do
else liftIO $ getDataDir
else liftIO $ getDataDir
if s then (liftIO $ putStrLn =<< getDataDir) >> cont else cont
-
+
+
+-- | connects to database checks if custom database path is set
getDb :: (MonadReader VConfig m, MonadIO m) => m Connection
getDb = do
env <- ask
@@ -47,65 +46,52 @@ getDb = do
path <- path'
let fullpath = (path ++ "/data/todo.db")
liftIO $ connectSqlite3 fullpath
-
---convRow :: [[SqlValue]] -> [[String]]
+
+-- | converts from sqlValues to Strings
+convRow :: [[SqlValue]] -> [[String]]
convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat
-
---makeQuery :: Query -> IO [[String]]
+-- | takes sqlQuery and returns results as a string
makeQuery :: (MonadReader VConfig m, MonadIO m) => String -> m [[String]]
makeQuery query = do
conn <- getDb
taskRaw <- liftIO $ quickQuery' conn query []
liftIO $ disconnect conn
- return (convRow taskRaw)
- {-
-makeQuery query = getDb >>= \conn -> quickQuery' conn query [] >>=
- \taskRaw -> disconnect conn >> return ( convRow taskRaw)
-
--}
-
-
---execQuery :: (MonadReader VConfig m, MonadIO m) => Query -> [a] -> m ()
-execQuery query params = getDb >>= \conn -> liftIO $ prepare conn query >>=
- \stmt -> execute stmt ( map toSql params) >> commit conn >> disconnect conn
-
+ return (convRow taskRaw)
-
+-- | executes a query that changes values in database
+execQuery :: (Convertible a SqlValue,
+ MonadIO m,
+ MonadReader VConfig m) => String -> [a] -> m ()
+execQuery query params = do
+ conn <- getDb
+ stmt <- liftIO $ prepare conn query
+ _ <- ($) liftIO $ execute stmt (map toSql params)
+ _ <- ($) liftIO $ commit conn
+ liftIO $ disconnect conn
+-- | gets the task id for the next avaible todo
getNextId :: (MonadReader VConfig m, MonadIO m) => m Integer
getNextId = do
f <- makeQuery "select id from todo order by id desc"
let rawid = head $ f
- let id = (read (rawid !! 0) :: Integer) +1
- return id
-
-
-
+ pure $ (read (rawid !! 0) :: Integer) +1
+-- | adds new task sanitizes input to avoid SQL escaping
addTask :: (MonadReader VConfig m, MonadIO m) => String -> String -> String -> String -> m ()
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
lastRowId <- getNextId
execQuery "insert into todo (id,Description,Title,Entered,Due,State,time,Subject ) Values (?,?,?,current_date,current_date,1,0,?)" $ [show lastRowId] ++ addD
+-- | lists the todo items finished today
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"
-
-
-
-
--- | Query to get average of subje
--- | Query to get sum of subjects
---getSum :: IO (Maybe [String])
-
-
-clean = id --replace "'" "''"
-
+-- | rudimentary sanitization
+clean :: String -> String
+clean = replace "''" "'"
diff --git a/src/Villefort/Definitions.hs b/src/Villefort/Definitions.hs
index 0a9bc2c..44251af 100644
--- a/src/Villefort/Definitions.hs
+++ b/src/Villefort/Definitions.hs
@@ -1,5 +1,6 @@
module Villefort.Definitions where
+-- | Villefort Configuration data
data VConfig = VConfig {
daily :: [IO [String]],
monthly :: [[String]],
@@ -12,6 +13,7 @@ data VConfig = VConfig {
database :: String
}
+-- | Villefort Weekly task datatype
data Weekly = Weekly {
monday :: [IO[String]],
tuesday :: [IO[String]],
diff --git a/src/Villefort/Log.hs b/src/Villefort/Log.hs
index 9060176..095c90f 100644
--- a/src/Villefort/Log.hs
+++ b/src/Villefort/Log.hs
@@ -1,14 +1,14 @@
{-# 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 Control.Monad.Reader (MonadReader,MonadIO,liftIO)
+import Villefort.Definitions (VConfig(..))
+import Villefort.Database (getSubjects,makeQuery,clean)
+import Villefort.Util (makeTable)
+import Paths_Villefort (getDataFileName)
+import System.Random (randomRIO)
--- | Generate stats
+-- | Generate stats page
genStats :: (MonadReader VConfig m, MonadIO m) => m String
genStats = do
subjects <- getSubjects
@@ -19,12 +19,11 @@ genStats = do
header <- liftIO (readFile x)
return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable ["Subject","time"] statsSum) ++ "</html>" ++ (mconcat gits))
-
-
-
+-- | get average time spent on each category
getAvg :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getAvg = makeQuery "select avg(time), Subject from todo group by Subject order by avg(time) desc"
+-- | get total time spent on each category
getSum :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getSum = makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"
@@ -34,8 +33,8 @@ 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 :: (MonadIO m, MonadReader VConfig m)
+ => String -> m String
makeGithub subject = do
z <- makeQuery ("select substr(Due,1,10) from todo where subject = '" ++ (clean subject) ++ "' and state = 0")
color <- liftIO $ getColor
@@ -44,6 +43,7 @@ makeGithub subject = do
let bot = " ], color: " ++ color ++ " }); </script>"
return (header ++ (Prelude.concat q )++ bot)
+-- | default colors for the daily charts
statsColors :: [String]
statsColors = ["'#F44336'"
,"'#E91E63'"
@@ -66,15 +66,9 @@ statsColors = ["'#F44336'"
,"'#607D8B'"
]
-
+-- | gets random colors for chart
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]]))
diff --git a/src/Villefort/New.hs b/src/Villefort/New.hs
index fac8456..8a5ae25 100644
--- a/src/Villefort/New.hs
+++ b/src/Villefort/New.hs
@@ -1,15 +1,15 @@
{-# 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
+module Villefort.New (makeNewPage) where
+import Control.Monad.Reader (MonadReader,MonadIO,liftIO)
+import Villefort.Definitions (VConfig(..))
+import System.IO.Strict as S (readFile)
+import Paths_Villefort (getDataFileName)
+import Data.List.Split (splitOn)
+import Villefort.Database (getSubjects)
+-- | make add new pages
makeNewPage :: (MonadReader VConfig m, MonadIO m) => m String
makeNewPage = do
headerPath <-liftIO $ getDataFileName "templates/header"
@@ -21,7 +21,6 @@ makeNewPage = do
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"
diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs
index ad5c608..c4c13bc 100644
--- a/src/Villefort/Server.hs
+++ b/src/Villefort/Server.hs
@@ -2,26 +2,35 @@
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Server where
-import Web.Scotty
-import Control.Monad.Reader
-import Control.Concurrent
-import Data.Text.Lazy hiding (splitOn,map,concat,head,replace)
-import Villefort.Database
+import Web.Scotty (scotty
+ , get
+ , html
+ , post
+ , body
+ , redirect
+ , html
+ , param
+ , file)
+import Control.Monad.Reader (liftIO,runReaderT)
+import Control.Concurrent (forkIO)
+import Data.Text.Lazy (pack)
+import Villefort.Database (addTask)
import Villefort.Todo (deleteTodo,getTodos,updateTodos)
-import Villefort.Log
-import Villefort.Definitions
-import Villefort.Weekly
-import Paths_Villefort
-import Villefort.Daily
+import Villefort.Log (genStats)
+import Villefort.Definitions (VConfig(..))
+import Villefort.Weekly (weeklyStats)
+import Paths_Villefort (getDataFileName,getDataDir)
+import Villefort.Daily (dailyCheck)
import Villefort.New (makeNewPage)
-import Villefort.Today
-import Data.List.Split
-import System.Environment
-import System.Process
-import System.Directory
-import System.Posix.Process
-import Data.String.Utils
+import Villefort.Today (getSummary)
+import Data.List.Split (splitOn)
+import System.Environment (getArgs)
+import System.Process (createProcess,proc,waitForProcess)
+import System.Directory (getAppUserDataDirectory,doesFileExist)
+import System.Posix.Process (executeFile)
+import Data.String.Utils (replace)
+-- | parses value from raw html post form
getIndex :: [[Char]] -> Int -> [Char]
getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1
@@ -31,8 +40,6 @@ convDate date = newDate
where splitDate = Data.List.Split.splitOn "%2F" date
newDate = (splitDate !! 2) ++ "-" ++ (splitDate !! 0) ++ "-" ++ (splitDate !! 1)
-
-
-- | Entry point for server attempts to recompile if needed
villefort :: VConfig -> IO ()
villefort conf = do
@@ -51,7 +58,7 @@ recompile = do
dir <- getAppUserDataDirectory "villefort"
let execPath = dir ++ "/villefort"
sourcePath = dir ++"/villefort.hs"
- (_,_,_,pid) <- createProcess (proc "/usr/bin/ghc" ["-o",execPath,sourcePath])
+ (_,_,_,pid) <- createProcess (proc "ghc" ["-o",execPath,sourcePath])
_ <-
waitForProcess pid
return ()
@@ -88,11 +95,9 @@ launch conf = do
post "/update" $ do
rawHtml <- body
let da = Data.List.Split.splitOn "&" (show rawHtml)
- do liftIO $ print $ show da
let rawid = Data.List.Split.splitOn "=" $ (Prelude.init (da !! 1))
let sqlId = read (rawid!! 1) :: Int
let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)
- do liftIO $ print rawtime
let insertTime = read (rawtime !! 1) :: Int
liftIO $ runReaderT (updateTodos sqlId insertTime) conf
redirect "/"
@@ -100,8 +105,6 @@ launch conf = do
post "/add" $ do
rawBody <-body
let parse = Data.List.Split.splitOn "&" (show rawBody)
- do liftIO $ print parse
- -- !@#$%^&*()_+
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
@@ -126,5 +129,3 @@ launch conf = do
get "/log" $ do
page <- liftIO $runReaderT genStats conf
html $ pack page
-
-
diff --git a/src/Villefort/Today.hs b/src/Villefort/Today.hs
index a510896..ffa2969 100644
--- a/src/Villefort/Today.hs
+++ b/src/Villefort/Today.hs
@@ -1,12 +1,12 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Today where
+module Villefort.Today (getSummary) where
-import Control.Monad.Reader
-import Villefort.Definitions
-import Villefort.Database
-import Villefort.Util
-import Data.List
+import Control.Monad.Reader (MonadReader,MonadIO)
+import Villefort.Definitions (VConfig)
+import Villefort.Database (getDone)
+import Villefort.Util (getHeader,makeTable,total)
+-- | creates today page
getSummary :: (MonadReader VConfig m, MonadIO m) => m String
getSummary = do
dat <- getDone
diff --git a/src/Villefort/Todo.hs b/src/Villefort/Todo.hs
index b2addbd..a1c56d5 100644
--- a/src/Villefort/Todo.hs
+++ b/src/Villefort/Todo.hs
@@ -1,51 +1,50 @@
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Todo where
-import Villefort.Definitions
-import Villefort.Database
-import Villefort.Util
-import Control.Monad.IO.Class
-import Data.List.Split
-import Data.ByteString.Lazy hiding (map,length,take,readFile,zip,head)
-import Paths_Villefort
-import Database.HDBC
-import Control.Monad.Reader
-import Data.List.Split as S
-import Data.Time
-
+import Villefort.Definitions (VConfig(..))
+import Villefort.Database (execQuery,getDb)
+import Villefort.Util (getHeader)
+import Data.List.Split (splitOn)
+import Data.ByteString.Lazy (ByteString)
+import Paths_Villefort (getDataFileName)
+import Database.HDBC (SqlValue,fromSql,quickQuery',disconnect)
+import Control.Monad.Reader (MonadReader,MonadIO,liftIO,ask)
+import Data.Time (getZonedTime,fromGregorian,diffDays)
+
+-- | difference betweeen the current day and the supplied day
daysUntil :: [Char] -> IO Integer
daysUntil date = do
- let splits = S.splitOn "-" date
+ let splits = 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)
+ let dateWhenDue = fromGregorian (read (splits !! 0) :: Integer) (read (splits !! 1) :: Int) (read (splits !! 2) :: Int)
+ let currentDateSplit = splitOn "-" current
+ let currentDate = fromGregorian ( read (currentDateSplit !! 0) :: Integer) (read (currentDateSplit !! 1) :: Int) (read (take 2 ( currentDateSplit !! 2)) :: Int)
+ return $ (diffDays dateWhenDue currentDate)
-
-
data Row = Row { rid :: Int,
title :: String,
description :: String,
due :: String,
subject :: String,
- time :: Int,
- pred :: Double
+ time :: Int
} deriving (Show,Eq)
-toRow :: [String] -> Int -> Double -> Row
+-- | Used to create row takes time spent as an integer
+toRow :: [String] -> Int -> Row
toRow x = Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4)
+-- | update the time taken on a certain project
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]
+-- | removes task from database
delTask :: (MonadReader VConfig m, MonadIO m) => Int -> m ()
delTask sqlId = execQuery "update todo set state = 0 where id = ?" [sqlId]
-- | returns time spent on task based off of Task id
getTime :: (MonadReader VConfig m,MonadIO m) => String -> m Int
-getTime id = do
- idval <- makeQuery' $ "select sum(time) from todo where id = " ++ show id
+getTime taskId = do
+ idval <- makeQuery' $ "select sum(time) from todo where id = " ++ show taskId
pure $ (read ((idval !! 0) !! 0) :: Int)
@@ -55,28 +54,26 @@ qetTasks' = do
x <- makeQuery' "select id, Title, Description, Due, Subject, pred from todo where state=1 group by id order by Due"
let ids = map head x
times <- mapM getTime ids
- liftIO $ print $ length times
- let halfRows = (map toRow x) :: [Int -> Double -> Row]
- liftIO $ print $ length halfRows
- let z = apply halfRows times
- return $ apply z [0,0 .. 1]
+ let halfRows = (map toRow x) :: [Int -> Row]
+ return $ apply halfRows times
+
-- | applies a list of functions to a list of values
apply :: [t -> a] -> [t] -> [a]
apply (x:xs) (y:ys) = [x y] ++ apply xs ys
apply [] (_:_) = []
apply [] []= []
+apply (_:_) [] = []
convRow' :: [[SqlValue]] -> [[String]]
convRow' dat = Prelude.map (\x -> Prelude.map (\y -> conv' y ) x) dat
---conv h:: SqlValue -> String
+-- | Converts from SqlVal to String
conv' :: SqlValue -> String
conv' x = case fromSql x of
Just y -> fromSql y :: String
Nothing -> "0"
-
---makeQuery :: Query -> IO [[String]]
--- |makes Query
+
+-- | makes Query that returns string
makeQuery' :: (MonadReader VConfig m, MonadIO m) => String -> m [[String]]
makeQuery' query = do
conn <- getDb
@@ -89,6 +86,7 @@ merge :: [a] -> [a] -> [a]
merge [] ys = ys
merge (x:xs) ys = x:merge ys xs
+
-- | generates modal for task based of Row data Structure
genModal' :: Row -> IO String
genModal' row = if rid row == 1 then return (" ") else do
@@ -102,16 +100,13 @@ genModal' row = if rid row == 1 then return (" ") else do
title row,
description row,
show $ time row,
- show $ Villefort.Todo.pred row,
"/delete",
show $ rid row
]
return $ mconcat $ merge modal da
-
-
---genModal row =
+-- | Generates bootstrap color from days until due
daysToColor' :: (Num a, Ord a) => a -> String
daysToColor' x = if x < 1 then "btn-due0"
else if x == 1 then "btn-due1"
@@ -123,7 +118,7 @@ daysToColor' x = if x < 1 then "btn-due0"
else "btn-due7"
-
+-- | reduce size of title to fit in bootstrap modal preview
convTitle :: String -> String
convTitle longTitle
| length s1 > 30 = s1
@@ -138,11 +133,12 @@ convTitle longTitle
s4 = mconcat (take 4 splits)
-getModal :: IO [[Char]]
---getModal = path >>= \path -> readFile (path ++ "templates/modal.ts") >>= \rawModal -> return (Data.List.Split.splitOn "}" rawModal)
-getModal = getDataFileName "templates/modal.ts" >>= \path -> readFile path>>= \rawModal -> return (Data.List.Split.splitOn "}" rawModal)
-
-
+-- | returns the modal template for bootstrap
+getModal :: IO [String]
+getModal = do
+ path <- getDataFileName "templates/modal.ts"
+ rawModal <- readFile path
+ return (Data.List.Split.splitOn "}" rawModal)
-- | Returns html from todos
getTodos :: (MonadReader VConfig m, MonadIO m) => m String
@@ -159,7 +155,7 @@ getTheme :: (MonadReader VConfig m, MonadIO m) => m String
getTheme = do
userConfig <- ask
let userColor = colors userConfig
- let mix = zip [0 ..] userColor
+ let mix = zip [0 ..] userColor :: [(Int,String)]
return $ "<style>" ++ (mconcat $ map genSelector mix) ++ "</style>"
where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n background:" ++ (snd x ) ++ "; \n color: #ffffff; }\n"
diff --git a/src/Villefort/Util.hs b/src/Villefort/Util.hs
index 60207d6..6638b70 100644
--- a/src/Villefort/Util.hs
+++ b/src/Villefort/Util.hs
@@ -1,11 +1,15 @@
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Util where
-import Control.Monad.Reader
-import Villefort.Definitions
-import Paths_Villefort
-import Data.List
-
+import Control.Monad.Reader (MonadReader,MonadIO,liftIO)
+import Villefort.Definitions (VConfig(..))
+import Paths_Villefort (getDataFileName)
+import Data.List (intercalate)
+import Data.Time (Day(..),fromGregorian,getZonedTime)
+import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
+import Data.List.Split as S (splitOn)
+
+-- | Returns header of Villefortx
getHeader :: (MonadReader VConfig m, MonadIO m) => m String
getHeader = do
headerPath <- liftIO $ getDataFileName "templates/header"
@@ -21,6 +25,35 @@ 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>"
-
+-- | toatals minutes on row
total :: [[String]] -> Int
total row = sum $ map (\x -> read $ x !! 1 :: Int) row
+
+-- | Date representation
+data D = D { year :: Integer,
+ month :: Int,
+ day :: Int} deriving (Show)
+
+-- | Convert from string to Day datatype
+fromZonedTimeToDay :: String -> Day
+fromZonedTimeToDay x = fromGregorian (year up ) (month up ) (day up)
+ where up = unpackStringToDate x
+
+-- | get Current local time
+getDate :: IO Day
+getDate = fromZonedTimeToDay <$> show <$> getZonedTime
+
+-- | get Local Date
+getDateD :: IO D
+getDateD = unpackStringToDate <$> show <$> getZonedTime
+
+-- | 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)
+ where nums = S.splitOn "-" $ take 10 x
+
+-- | Get local day of week as number
+getDay :: IO Int
+getDay = do
+ z <- getDate
+ return $ snd $mondayStartWeek z
diff --git a/src/Villefort/Weekly.hs b/src/Villefort/Weekly.hs
index 9908da4..34f1d6a 100644
--- a/src/Villefort/Weekly.hs
+++ b/src/Villefort/Weekly.hs
@@ -1,56 +1,43 @@
{-# LANGUAGE FlexibleContexts #-}
-module Villefort.Weekly (weeklyStats) where
+module Villefort.Weekly where
-import Control.Monad.Reader
-import Villefort.Definitions
---import Villefort.Time (getDatesOfPrevWeek,getDatesOfThisWeek)
+import Control.Monad.Reader (MonadIO,MonadReader,liftIO)
+import Villefort.Definitions (VConfig(..))
import Villefort.Util
-import Villefort.Database
-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
- -}
-
+import Villefort.Database (makeQuery)
+import Data.Time (Day,addDays,fromGregorian)
+import Data.Time.Calendar.WeekDate (toWeekDate)
+import Data.List (nub)
+-- | Return the list of days in the previous week
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
+-- | Return the list of days that have happened this week
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
-
+
+-- | returns the start of the date
getStartOfWeek :: IO Day
getStartOfWeek = do
currentDay <- toInteger <$> getDay
today <- getDate
return $ addDays (-currentDay) today
+
+-- | Convert from string to Day datatype
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
-
+fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up)
+ where up = unpackStringToDate x
+
+-- | returns the days that have happened this week
getDatesOfWeek :: IO [Day]
getDatesOfWeek = do
start <- getStartOfWeek
@@ -58,9 +45,7 @@ getDatesOfWeek = do
return $ tail $ take (currentDay+1) $ scanl next start [1,1 .. ]
where next s x = addDays (x) s
-
-
-
+-- | generates weekly page
weeklyStats :: (MonadReader VConfig m, MonadIO m) => m String
weeklyStats = do
dates<- liftIO getDatesOfWeek
@@ -70,39 +55,41 @@ weeklyStats = do
headerdays<- (header ++ ) <$> addWeek <$> mconcat <$> mapM getSummaryDay dates
d <- genTabs
return $ headerdays++ d
-
+
+-- | returns a summary table for each day
getSummaryDay :: (MonadReader VConfig m, MonadIO m) => Day -> m String
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"]
-
+
+-- | returns the subject and total times completed last week
getPrevWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getPrevWeek = do
dayOfWeek <- liftIO $ getDatesOfPrevWeek
t dayOfWeek
-
where t = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))
-
--- "2017-10-30"
--- ""2017-11-03"
+-- | returns the subject and total times completed this week
getThisWeek :: (MonadReader VConfig m, MonadIO m) => m [[String]]
getThisWeek = do
firstOfWeek<- liftIO $ getDatesOfThisWeek
t firstOfWeek
where t = (\x -> getSubWeek (show $ x !! 0) (show $ x !! 1))
+-- | creates the difference table for last week and this week
genTabs :: (MonadReader VConfig m, MonadIO m) => m String
genTabs = do
datesOfThisWeek <- getThisWeek
t <- getPrevWeek
return $ makeTable ["Subject","Last week ","This week "] $ firstSecond $ spec1 t datesOfThisWeek
+-- | ges the todos finished today
getDoneDay :: (MonadReader VConfig m, MonadIO m) =>String -> m [[String]]
getDoneDay queryDay = makeQuery $ "select Title, time from todo where substr(Due,1,10) = '"++ queryDay ++ "' and time != 0"
+-- | algorithm to sort different weeks subject and days nicely so that it displays well
spec1 :: [[String]] -> [[String]] -> [[String]]
spec1 lastWeek thisWeek = merge1 (fst main) (snd main)
where set = nub $ map (\x -> x !! 0) $ lastWeek ++ thisWeek
@@ -114,25 +101,29 @@ spec1 lastWeek thisWeek = merge1 (fst main) (snd main)
main = (map (\q -> selectNum (fst q) (snd q) ) $ zip diff1 set1,
map (\q -> selectNum (fst q) (snd q) ) $ zip diff2 set2)
+-- | looks up number in table if it's not avaible default to zero
selectNum :: Bool -> (String,[String]) -> [String]
selectNum x y = if x then snd y else [fst y,"0"]
+-- | zips with padding when one list runs out it fills in a default value
zipWithPadding :: a -> b -> [a] -> [b] -> [(a,b)]
zipWithPadding a b (x:xs) (y:ys) = (x,y) : zipWithPadding a b xs ys
zipWithPadding a _ [] ys = zip (repeat a) ys
zipWithPadding _ b xs [] = zip xs (repeat b)
+-- | Merges two lists
merge1 :: [a] -> [a] -> [a]
merge1 xs [] = xs
merge1 [] ys = ys
merge1 (x:xs) (y:ys) = x : y : merge1 xs ys
-
+-- | extracts the right table data for diff table s
firstSecond :: [[String]] -> [[String]]
firstSecond (x:y:xs) = [(x ++ [(y !! 1)])] ++ firstSecond xs
firstSecond [_] = []
firstSecond [] = []
+-- | returns subject and times between start and end days
getSubWeek :: (MonadReader VConfig m, MonadIO m) => String -> String -> m [[String]]
getSubWeek start end= makeQuery $ "select subject,sum(time) \
\ from todo where \
diff --git a/templates/modal.ts b/templates/modal.ts
index f186271..202ba04 100644
--- a/templates/modal.ts
+++ b/templates/modal.ts
@@ -12,10 +12,8 @@
<h4 class="modal-title"> } </h4>
</div>
<div class="modal-body">
- <p> } </p>
-
+ <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">