diff --git a/README.md b/README.md --- 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 @@ ```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 @@ ``` -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 @@ 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 @@ |-- templates/ |-- js.js ``` -Villefort-0.1.1.1/ +Villefort-0.1.2.13/ ``` |-- data/ | |-- date @@ -92,7 +93,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 so that your custom build uses the new version of Villefort. 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.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 @@ 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 @@ , unix , bytestring , transformers - , MissingH + , MissingH + , convertible default-language: Haskell2010 diff --git a/src/Villefort.hs b/src/Villefort.hs deleted file mode 100644 --- a/src/Villefort.hs +++ /dev/null @@ -1,1 +0,0 @@ -module Villefort where diff --git a/src/Villefort/Config.hs b/src/Villefort/Config.hs --- 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 @@ -- | 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 --- 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 @@ 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 @@ 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 --- 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 @@ 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 @@ 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 --- 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 @@ 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 --- 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 @@ header <- liftIO (readFile x) return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "

Sum

" ++ (makeTable ["Subject","time"] statsSum) ++ "" ++ (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 = "

avg

" -- | 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 @@ let bot = " ], color: " ++ color ++ " }); " return (header ++ (Prelude.concat q )++ bot) +-- | default colors for the daily charts statsColors :: [String] statsColors = ["'#F44336'" ,"'#E91E63'" @@ -66,15 +66,9 @@ ,"'#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 --- 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" @@ -20,7 +20,6 @@ subjects <- getSubjects let radiobuttons = map makeRadio subjects return (htmlHeader ++ (splitWeeks !! 0) ++ (concat radiobuttons) ++ (splitWeeks !! 1)) - -- | makes html for radiobutton makeRadio :: String -> String diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs --- 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ get "/log" $ do page <- liftIO $runReaderT genStats conf html $ pack page - - diff --git a/src/Villefort/Today.hs b/src/Villefort/Today.hs --- 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 --- 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 @@ 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 [] 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 @@ 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 @@ 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 @@ 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 = do userConfig <- ask let userColor = colors userConfig - let mix = zip [0 ..] userColor + let mix = zip [0 ..] userColor :: [(Int,String)] return $ "" 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 --- 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 tableData stats = " " ++ "" ++ ( makeRow tableData) ++ "" ++ (mconcat (map makeRow stats)) ++ "
" - +-- | 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 --- 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 -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 +-- | Convert from string to Day datatype +fromZonedTimeToDay :: String -> Day +fromZonedTimeToDay x = fromGregorian (year up) (month up ) (day up) + where up = unpackStringToDate x -getDay :: IO Int -getDay = do - z <- getDate - return $ snd $mondayStartWeek z - +-- | returns the days that have happened this week getDatesOfWeek :: IO [Day] getDatesOfWeek = do start <- getStartOfWeek @@ -58,9 +45,7 @@ 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 @@ 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 @@ 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 --- a/templates/modal.ts +++ b/templates/modal.ts @@ -12,10 +12,8 @@

}

-

}

- +

}

Total minutes spent working on Project }

-

Predicted time }