Villefort 0.1.2.12 → 0.1.2.13

raw patch · 15 files changed

+282/−265 lines, 15 filesdep +convertiblenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: convertible

API changes (from Hackage documentation)

Files

• README.md +19/−18
• Villefort.cabal +4/−4
• src/Villefort.hs +0/−1
• src/Villefort/Config.hs +29/−2
• src/Villefort/Daily.hs +23/−33
• src/Villefort/Database.hs +43/−57
• src/Villefort/Definitions.hs +2/−0
• src/Villefort/Log.hs +13/−19
• src/Villefort/New.hs +8/−9
• src/Villefort/Server.hs +27/−26
• src/Villefort/Today.hs +6/−6
• src/Villefort/Todo.hs +39/−43
• src/Villefort/Util.hs +38/−5
• src/Villefort/Weekly.hs +30/−39
• templates/modal.ts +1/−3

@@ -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
 

@@ -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 

@@ -1,1 +0,0 @@-module Villefort where

@@ -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"]++++++++++

@@ -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

@@ -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 "''" "'"

@@ -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]],

@@ -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) ++ "</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 = " <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 @@   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 @@          ,"'#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]]))

@@ -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

@@ -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--      

@@ -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

@@ -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 $ "<style>" ++  (mconcat $ map genSelector mix) ++ "</style>"   where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n  background:" ++  (snd x ) ++ "; \n color: #ffffff; }\n"   

@@ -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 = "<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

@@ -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 \

@@ -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">