Villefort 0.1.0.8 → 0.1.1.0

raw patch · 23 files changed

+750/−393 lines, 23 filesdep +QuickCheckdep +directorydep +filepathdep ~HDBCdep ~HDBC-sqlite3dep ~scottyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, directory, filepath, process, strict, transformers, unix

Dependency ranges changed: HDBC, HDBC-sqlite3, scotty

API changes (from Hackage documentation)

Files

• Main.hs +7/−0
• README.md +29/−4
• Villefort.cabal +29/−8
• app/Main.hs +0/−113
• data/date +1/−0
• data/day +1/−0
• data/todo.db binary
• src/Database.hs +0/−49
• src/Stats.hs +0/−69
• src/Todo.hs +0/−149
• src/Villefort.hs +6/−0
• src/Villefort/Config.hs +24/−0
• src/Villefort/Daily.hs +7/−0
• src/Villefort/Database.hs +59/−0
• src/Villefort/Ml.hs +19/−0
• src/Villefort/Server.hs +257/−0
• src/Villefort/Stats.hs +87/−0
• src/Villefort/Summary.hs +15/−0
• src/Villefort/Time.hs +36/−0
• src/Villefort/Todo.hs +148/−0
• templates/header +1/−0
• templates/modal.ts +1/−0
• test/Spec.hs +23/−1

@@ -0,0 +1,7 @@+module Main where++import Villefort+import System.Random++main :: IO ()+main = villefort def

@@ -1,10 +1,35 @@ # Villefort
 Villefort is a time managment system written in Haskell.
 
-## What's new in version Villefort-0.1.0.8
-- Pretty colors on the stats page.
-- Fixed time tracking bug.
-- Better UX on the home page.
+## Now with xmonad style configuration!
+You can Configure
+-- the port
+-- daily tasks
+-- tasks to run on certain days of the week.
+
+create a custom main method in ~.villefort/villefort.hs example
+
+```haskell
+module Main where
+
+import Villefort
+
+
+main :: IO ()
+main = villefort def {
+           -- description			Title	       Subject
+  daily = [[ "Water Plants with 50ml of water","Water Plants","Garden"]] -- tasks to run daily
+  weekly = defWeekly {
+      friday = [return ["Freaky Friday","Friday","Admin"] -- tasks to run every friday
+      },
+  port = 3001
+    }
+```
+
+Then run ```Villefort --recompile```
+the next time you run villefort it will run with your configuration.
+
+The default configuration is located here https://github.com/Chrisr850/Villefort/blob/master/src/Villefort/Config.hs
 
 # Home screen
 ![alt text](https://raw.githubusercontent.com/Chrisr850/Villefort/master/data/screen.png)

@@ -1,5 +1,5 @@ name:                Villefort-version:             0.1.0.8+version:             0.1.1.0 synopsis: Villefort is a task manager and time tracker written in haskell. description: Villefort is a browser based time tracker. homepage:            https://github.com/Chrisr850/Villefort#readme@@ -12,7 +12,8 @@ build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10-data-files:            data/todo.db+data-files:            data/date+                     , data/day                      , templates/*.html                      , templates/*.ts                      , templates/header@@ -21,9 +22,17 @@ library   hs-source-dirs:      src   other-modules:       Paths_Villefort-  exposed-modules:     Database-                     , Todo-                     , Stats+  ghc-options:         -Wall+  exposed-modules:     Villefort+                     , Villefort.Todo+                     , Villefort.Database+                     , Villefort.Stats+                     , Villefort.Time+                     , Villefort.Daily+                     , Villefort.Ml+                     , Villefort.Summary+                     , Villefort.Config+                     , Villefort.Server   build-depends:       base >= 4.9 && < 5                      , HDBC >= 2.4.0 && < 2.5                      , HDBC-sqlite3 >= 2.3.3 && < 2.4@@ -32,14 +41,20 @@                      , FindBin >= 0.0.5 && < 0.1                      , mtl  >= 2.2.1 && < 2.3                      , random-                     +                     , process+                     , strict+                     , scotty+                     , text+                     , directory+                     , filepath+                     , unix+                     , transformers                     default-language:    Haskell2010  executable Villefort-  hs-source-dirs:      app   main-is:             Main.hs-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -fwarn-unused-binds -Wall   other-modules:       Paths_Villefort   build-depends:       base                      , Villefort@@ -49,6 +64,7 @@                      , split                      , text                      , time+                     , random   default-language:    Haskell2010  test-suite Villefort-test@@ -57,6 +73,11 @@   main-is:             Spec.hs   build-depends:       base                      , Villefort+                     , QuickCheck+                     , HDBC >= 2.4.0 && < 2.5+                     , HDBC-sqlite3 >= 2.3.3 && < 2.4+                     +                       ghc-options:         -threaded -rtsopts -with-rtsopts=-N    default-language:    Haskell2010 

@@ -1,113 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Web.Scotty-import Data.Char-import Control.Monad.IO.Class-import Database.HDBC.Sqlite3 -import Database.HDBC-import Data.List.Split -import Data.Text.Lazy.Encoding (decodeUtf8)-import Data.Text.Lazy hiding (splitOn,map,concat,head)-import Data.Time-import Database-import Todo-import Stats-import Paths_Villefort----getDone = makeQuery  "select Title, time  from todo where due = Date('now','localtime') and state = 0" --getWeeks = do-  raw <- makeQuery "select id, Title from weeks where state = 1 order by Title"-  return $ Prelude.mapM (\x -> [Prelude.head x ,( Prelude.tail (Prelude.last x))]) raw---getIndex :: [[Char]] -> Int -> [Char]-getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1----- | Converts date from Javascript to sqlite date fromat -convDate :: String -> String-convDate date = newDate-        where split = Data.List.Split.splitOn "%2F" date-              newDate = (split !! 2) ++ "-" ++ (split !! 0) ++ "-" ++ (split !! 1)----- | makes html for radiobutton-makeRadio x =  "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"- --makeNewPage = do-  headerPath <- getDataFileName "templates/header"-  header <- liftIO $ readFile headerPath-  addPath <- getDataFileName "templates/add.html"-  add <- liftIO $ readFile addPath-  let split = splitOn "?" add-  subjects <- getSubjects-  let radiobuttons =  map makeRadio subjects-  return (header ++ (split !! 0) ++ (concat radiobuttons) ++ (split !! 1))- --- | Main function of loop-main :: IO ()-main = do-  scotty 3002 $ do-    get "/" $ do-      todos <- liftIO  getTodos-      html $ pack $ todos-      -    get "/new" $ do-      page <- liftIO makeNewPage-      html $ pack page-      -    post "/delete" $ do-      raw <- body-      deleteTodo raw-      redirect "/"--    post "/update" $ do-      raw <- body-      let da   = Data.List.Split.splitOn "&" (show raw)-      do liftIO $ print $ show da-      let rawid = Data.List.Split.splitOn "=" $  (Prelude.init (da !! 1))-      let id   = read (rawid!! 1) :: Int-      let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)-      do liftIO $ print rawtime-      let time = read (rawtime !! 1) :: Int-      do liftIO $ updateTask id time-      redirect "/"--    post "/add" $ do-      raw <-body-      conn <- liftIO $ getDb-      let parse = Data.List.Split.splitOn "&" (show raw)-      do liftIO $ print parse-      let rep y = map (\x -> if x == '+' then ' ' else x) y-      let summary = rep $ getIndex parse 0-      let date    = convDate $ getIndex parse 3-      let title   = rep $ getIndex parse 1-      let subject = rep $ getIndex parse 2-      f <-liftIO $ makeQuery "select id from todo order by id desc"-      let rawid = head $ f-      let id = (read (rawid !! 0) :: Integer) +1-      stmt <- liftIO $ prepare conn "insert into todo (id,Description,Title,Entered,Due,State,time,Subject) Values (?,?,?,current_date,?,1,0,?)"-      do liftIO $ execute stmt [toSql id,toSql title,toSql summary,toSql date,toSql subject]-      do liftIO $ commit conn-      do liftIO $ disconnect conn-      redirect "/"--  -    get "/time" $ do-      dat <- liftIO $ getDone-      html $ pack  $ ("<h1> Shit I've done today </h1> " ++ (show dat))--   --    get "/js-chart-widgets.min.js" $ do-      path <- liftIO $  getDataFileName "js.js"-      file path-      -    get "/stat" $ do-      page <- liftIO $ genStats-      html $ pack page

@@ -0,0 +1,1 @@+2017-06-05

@@ -0,0 +1,1 @@+1

binary file changed (16384 → absent bytes)

@@ -1,49 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-module Database  where--import Control.Monad.IO.Class-import Control.Monad.State.Strict-import Database.HDBC.Sqlite3 -import Database.HDBC-import Data.List.Split-import System.Environment.FindBin-import Paths_Villefort-  -type Query = String-type Path  = String-type Subject = String-----getSubjects :: IO (Maybe [Subject])-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-path =fmap (\x -> (x !! 0) ++ "Villefort/") $  (Data.List.Split.splitOn "Villefort/") <$> getProgPath---path = getDataDir--path' = getDataDir--getDb :: IO Connection  -getDb =  (++ "/data/todo.db") <$> path' >>= \path -> putStrLn path >> connectSqlite3 path----convRow :: [[SqlValue]] -> [[String]]-convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat-----makeQuery :: Query -> IO [[String]]-makeQuery query = do-  conn <- getDb-  taskRaw <- quickQuery' conn query []-  disconnect conn-  return (convRow taskRaw)-  {--makeQuery query =  getDb >>=  \conn  ->  quickQuery' conn query [] >>=-  \taskRaw -> disconnect conn >> return ( convRow taskRaw)---}-  --execQuery :: Query -> [Int] -> IO ()-execQuery query params =  getDb >>= \conn ->  prepare conn query >>=-  \stmt ->  execute stmt ( map toSql params) >>  commit conn >> disconnect conn

@@ -1,69 +0,0 @@-module Stats (genStats-             )where-import Database-import Control.Monad.IO.Class-import Paths_Villefort-import System.Random--data Query = Query String---- | Query to get average of subjects---getAvg :: IO (Maybe [String])-getAvg =  makeQuery "select avg(time), Subject from todo  group by Subject order by avg(time) desc"---- | Query to get sum of subjects---getSum :: IO (Maybe [String])-getSum =  makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"---- | Helper function to generate row of table-makeRow x =  "<tr> <th>" ++ (x !! 0) ++ "</th> <th>  " ++ (x!! 1) ++ "</th> </tr>"---- | Generate Table-makeTable stats = "<table style='width:100%'>" ++ (mconcat (map  makeRow stats)) ++ "</table>"---- | Generate stats---genStats = getSubjects >>= \x ->  mapM makeGithub x >>= \gits -> getAvg >>=-  \avg -> getSum >>= \sum -> getDataFileName "templates/header" >>= \x -> liftIO (readFile x) >>= \head -> return (head ++ table ++ (makeTable avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable sum) ++ "</html>" ++ (mconcat gits))--- | Library to include for github table-table :: String-table = " <script src='/js-chart-widgets.min.js'></script><h1> avg </h1>"---- | creates the github like graph from database-----makeGithub :: Maybe String -> IO String-makeGithub subject = do-  z <-   makeQuery ("select Due from todo where subject = '" ++ subject ++ "' and state = 0")-  color <- getColor-  let head = "<h2 id='"++ subject ++ "'> Calendar "++ subject ++ " </h2> <script> new Calendar({ append_to: '" ++ subject ++ "',num_weeks: 51,day_size: 11, data: ["-  let q = Prelude.map (\x -> "['" ++ (x !! 0) ++"',500],") z-  let bot = "  ], color: " ++ color ++ " }); </script>"-  return (head ++ (Prelude.concat q )++  bot)--colors = ["'#F44336'"-         ,"'#E91E63'"-         ,"'#9C27B0'"-         ,"'#673AB7'"-         ,"'#3F51B5'"-         ,"'#2196F3'"-         ,"'#03A9F4'"-         ,"'#00BCD4'"-         ,"'#009688'"-         ,"'#4CAF50'"-         ,"'#8BC34A'"-         ,"'#CDDC39'"-         ,"'#FFEB3B'"-         ,"'#FFC107'"-         ,"'#FF9800'"-         ,"'#FF5722'"-         ,"'#795548'"-         ,"'#9E9E9E'"-         ,"'#607D8B'"-         ]--getColor = do-  number <- randomRIO (0, (length $ colors)-1) :: IO Int-  return (colors !! number)-  

@@ -1,149 +0,0 @@-module Todo (getTodos-            ,updateTask-            ,deleteTodo-            ,qetTasks'-            ,makeQuery'-            ,conv'-            ,convRow'-            ,genModal'-            ) where--import Database-import Data.List.Split-import Control.Monad.IO.Class-import Data.Time-import Data.List.Split as S-import Paths_Villefort-import Database.HDBC.Sqlite3 -import Database.HDBC---data Row = Row { rid :: Int,-                 title :: String,-                 description :: String,-                 due :: String,-                 time :: Int-               } deriving (Show)----toRow :: Maybe [String] -> Maybe Row-toRow x =  Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3) (read( x !! 4) :: Int)--qetTasks' = do-  -- I would like to take this moment to personally apoligize to the sql gods for creating this monstrosity.-  x <- makeQuery' "select id, Title, Description, Due,  sum(time) from todo where state=1 group by id "-  return (map toRow x)--convRow' dat = Prelude.map (\x -> Prelude.map (\y -> conv' y ) x) dat----conv :: SqlValue -> String-conv' x = case fromSql x of-  Just x -> fromSql x :: String-  Nothing -> "1"-----makeQuery :: Query -> IO [[String]]-makeQuery' query = do-  conn <- getDb-  taskRaw <- quickQuery' conn query []-  disconnect conn-  return (convRow' taskRaw)---merge [] ys = ys-merge (x:xs) ys = x:merge ys xs---  -genModal' row = if rid row == 1 then return (" ") else do-  let f = due row-  modal <- getModal-  days  <- daysTilDue f-  let da = [daysToColor' days ,-            show $ rid row,-            (convTitle $ title row) ++ "Due in " ++  show days,-            show $ rid row,-            title row,-            description row,-            show $ time row,-            "/delete",-            show $ rid row-           ]--  return $ mconcat $  merge modal da- ----genModal row =--daysToColor' x = if x < 1 then "btn-due0"-            else if x == 1 then "btn-due1"-            else if x == 2 then "btn-due2"-            else if x == 3 then "btn-due3"-            else if x == 4 then "btn-due4"-            else if x == 5 then "btn-due5"-            else if x == 6 then "btn-due6"-            else "btn-due7"-----convTitle title-  | length s1 > 30 = s1-  | length s2 > 30 = s2-  | length s3 > 30 = s3-  | length s4 > 30 = s4-  | otherwise = title-  where split = (Data.List.Split.splitOn "." title)-        s1 = (split !! 0)-        s2 = mconcat (take 2 split)-        s3 = mconcat (take 3 split)-        s4 = mconcat (take 4 split)-          --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)--daysTilDue date = do-  c <- getCurrentTime-  let (y,m,d) = toGregorian $ utctDay c-  let split = Data.List.Split.splitOn "-" date-  current <- fromZonedTimeToDay <$> show <$> getZonedTime-  let due     = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (split !! 2) :: Int)-  return $ (diffDays  due current) --fromZonedTimeToDay x = fromGregorian (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int) -  where nums = S.splitOn "-" $  take 10 x-  --- | Returns html from todos -getTodos = do-  tasks <-  qetTasks'-  do liftIO $ putStrLn $ show tasks-  path  <- path -  modals <- sequence $  genModal' <$>  tasks-  headerPath <- getDataFileName "templates/header"-  header <- liftIO $ readFile headerPath-  let body = Prelude.concat modals-  return (header ++  body)---- | Delete a done task from database sets state = 0 but it's record is still maintained in the database for the stats page.-deleteTodo raw = do-    let da   = Data.List.Split.splitOn "&" (show raw)-    let rawid = Data.List.Split.splitOn "=" $  (Prelude.init (da !! 1))-    let id   = read (rawid!! 1) :: Int-    let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)-    let time = read (rawtime !! 1) :: Int-    do liftIO $ delTask id -    do liftIO $ addTime id time-    return ()---addTime :: Int -> Int -> IO ()-addTime id time = execQuery "update todo set time = ? where id = ?" [time,id]-  -delTask :: Int ->  IO ()-delTask id = execQuery "update todo  set state = 0 where id = ?" [id]--updateTask :: Int -> Int ->  IO ()-updateTask id time = execQuery "insert into todo (id,Description,Title,Entered,Due,state,time,Subject) select id,Description,Title,Entered,Due,1,?,Subject from todo where id = ? limit 1" [ time, id]--

@@ -0,0 +1,6 @@+module Villefort (+module Villefort.Server,+module Villefort.Config+                 ) where+import Villefort.Server+import Villefort.Config

@@ -0,0 +1,24 @@+ module Villefort.Config  where++import System.Process+import System.Environment.FindBin+import Villefort.Server+def = VConfig {+  daily = [[]],+  monthly =[[]],+  yearly =[[]],+  weekly = defWeekly,+  port = 3002+              }++defWeekly = Weekly {+  monday = [return []],+  tuesday =[return[]],+  wednesday = [return[]],+  thursday = [return[]],+  friday  = [return[]],+  saturday = [return[]],+  sunday  = [return []]+                   }++-- ghc -o /home/chris/.villefort/villefort /home/chris/.villefort/villefort.hs

@@ -0,0 +1,7 @@+module Villefort.Daily where+import Villefort.Time+import Villefort.Database+import Control.Concurrent+import Control.Monad+import System.IO.Strict as S+import Paths_Villefort

@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleContexts #-}+module Villefort.Database  where++import Control.Monad.IO.Class+import Database.HDBC.Sqlite3 +import Database.HDBC+import Data.List.Split+import System.Environment.FindBin+import System.Environment+import Paths_Villefort+  +type Query = String+type Path  = String+type Subject = String+++getSubjects :: IO  [Subject]+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++path' :: IO FilePath+path' = do+  args <- getArgs+  if args !! 0 == "--custom"+    then return $ args !! 1+    else getDataDir++getDb :: IO Connection  +getDb =  (++ "/data/todo.db") <$> path' >>= \path ->  connectSqlite3 path++--convRow :: [[SqlValue]] -> [[String]]+convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat+++--makeQuery :: Query -> IO [[String]]+makeQuery query = do+  conn <- getDb+  taskRaw <- quickQuery' conn query []+  disconnect conn+  return (convRow taskRaw)+  {-+makeQuery query =  getDb >>=  \conn  ->  quickQuery' conn query [] >>=+  \taskRaw -> disconnect conn >> return ( convRow taskRaw)++-}+  ++--execQuery :: Query -> [Int] -> IO ()+execQuery query params =  getDb >>= \conn ->  prepare conn query >>=+  \stmt ->  execute stmt ( map toSql params) >>  commit conn >> disconnect conn++getNextId ::IO Integer+getNextId = do+  f <-liftIO $ makeQuery "select id from todo order by id desc"+  let rawid = head $ f+  let id = (read (rawid !! 0) :: Integer) +1+  return id

@@ -0,0 +1,19 @@+module Villefort.Ml where++import System.Process+import Control.Monad+import Control.Concurrent++train :: IO ()+train = do+    callCommand "/home/chris/Haskell/Villefort/ml/Train.py" >> putStrLn "train"+predict :: IO ()+predict = do+   callCommand"/home/chris/Haskell/Villefort/ml/Predict.py" >> putStrLn "predict"+ml :: IO ()+ml = do+ -- predict+  threadDelay 18000000+  +dailyMl :: IO ()+dailyMl = forever ml

@@ -0,0 +1,257 @@+{-# LANGUAGE OverloadedStrings #-}+module Villefort.Server  where++import Web.Scotty+import Control.Monad.IO.Class+import Control.Concurrent+import Data.List.Split+import Data.Text.Lazy hiding (splitOn,map,concat,head)+import Villefort.Database+import Villefort.Todo+import Villefort.Stats+import Paths_Villefort+import Villefort.Daily+import Villefort.Ml+import Villefort.Time+import Villefort.Summary+import System.IO.Strict as S+import System.Environment+import Control.Monad+import System.Environment.FindBin+import System.Process+import System.Directory+import System.FilePath+import System.Posix.Process+import Paths_Villefort+getWeeks :: IO [[[Char]]]+getWeeks = do+  rawSql <- makeQuery "select id, Title from weeks where state = 1 order by Title"+  return $ Prelude.mapM (\x -> [Prelude.head x ,( Prelude.tail (Prelude.last x))]) rawSql+++getIndex :: [[Char]] -> Int -> [Char]+getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1+++-- | Converts date from Javascript to sqlite date fromat +convDate :: String -> String+convDate date = newDate+        where splitDate = Data.List.Split.splitOn "%2F" date+              newDate = (splitDate !! 2) ++ "-" ++ (splitDate !! 0) ++ "-" ++ (splitDate !! 1)+++-- | makes html for radiobutton+makeRadio :: String -> String+makeRadio x =  "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"+ +makeNewPage :: IO String+makeNewPage = do+  headerPath <- getDataFileName "templates/header"+  htmlHeader <- liftIO $ S.readFile headerPath+  addPath <- getDataFileName "templates/add.html"+  add <- liftIO $ S.readFile addPath+  let splitWeeks = splitOn "?" add+  subjects <- getSubjects+  let radiobuttons =  map makeRadio subjects+  return (htmlHeader ++ (splitWeeks !! 0) ++ (concat radiobuttons) ++ (splitWeeks !! 1))+ +-- | Main function of loop++data VConfig  = VConfig {+  daily :: ![[String]],+  monthly :: [[String]],+  yearly :: [[String]],+  weekly :: Weekly,+  port :: Int}++data Weekly = Weekly {+  monday :: [IO[String]],+  tuesday :: [IO[String]],+  wednesday :: [IO[String]],+  thursday :: [IO[String]],+  friday :: [IO[String]],+  saturday :: [IO[String]],+  sunday ::[IO[String]]+                     }+++++writeDate :: IO ()+writeDate = do+  date <-  show <$> getDate+  datePath <- getDataFileName "data/date"+  writeFile datePath date++readDate :: IO D+readDate = do+  datePath <- getDataFileName "data/date"+  raw <-  S.readFile datePath+  let date = unpackStringToDate raw+  return date++writeDay :: IO ()+writeDay = do+  day <- show <$> getDay+  datePath <- getDataFileName "data/day"+  writeFile datePath day++readDay :: IO Int+readDay = do+  datePath <- getDataFileName "data/day"+  raw <- S.readFile datePath+  let int = read raw :: Int+  return int+  +checkDay :: D -> D ->Bool+checkDay oldDate currentDate= ((day oldDate) == (day currentDate))+checkMonth :: D -> D -> Bool+checkMonth oldDate currentDate = (month oldDate) == (month currentDate)+checkYear :: D -> D -> Bool+checkYear oldDate currentDate  = (year oldDate)  == (year currentDate)+++runDaily vconf oldDate currentDate=+  if (checkDay oldDate currentDate) then+    putStrLn "same-day"+  else+    putStrLn "adding-daily" >> putStrLn (show ( daily vconf)) >> mapM_ addDaily (daily vconf)+               +runMonthly :: D -> D -> IO ()+runMonthly oldDate currentDate = if(checkMonth oldDate currentDate) then+  putStrLn "same-month"+  else+  putStrLn "adding monthly"++runYearly :: D -> D -> IO ()+runYearly oldDate currentDate = if(checkYear oldDate currentDate) then+  putStrLn "same-year"+  else+  putStrLn "adding yearly"++addDaily :: [String] -> IO ()+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++runWeekly :: VConfig -> Int -> Int -> IO ()+runWeekly conf old current = do+  if old /= current+    then do+    let stmt = selector conf (current-1)+    stmts <- sequence stmt+    mapM_ add stmts+    else return ()+    where add = (\x -> if Prelude.null x then return () else addDaily x)+          +selector  conf x+  | x == 0 = monday lookup+  | x == 1 = tuesday lookup+  | x == 2 = wednesday lookup+  | x == 3 = thursday lookup+  | x == 4 = friday lookup+  | x == 5 = saturday lookup+  | otherwise = sunday lookup +    where lookup = weekly conf+  +  +  ++--man :: IO ()+man conf = do+  oldDate <- readDate+  currentDate <- getDateD+  oldDay <- readDay+  currentDay <- getDay+  runWeekly conf oldDay currentDay+  runDaily conf oldDate currentDate+  writeDate+  writeDay+  threadDelay 18000000+  ++dailyCheck conf = forever$  man conf++villefort conf = do+  args <- getArgs+  case args of+    +    ["--custom",x] -> putStrLn "custom" >> launch conf +    ["--recompile"] -> putStrLn "recompiling" >> recompile+    _ ->do putStrLn "straight startign " >> checkCustomBuild >> launch conf++recompile :: IO ()+recompile = do+  dir <- getAppUserDataDirectory "villefort"+  let execPath = dir ++ "/villefort"+      sourcePath = dir ++"/villefort.hs"+  (_,_,_,pid) <- createProcess (proc "/usr/bin/ghc" ["-o",execPath,sourcePath])+  waitForProcess pid+  return ()++checkCustomBuild = do+  dir <- getAppUserDataDirectory "villefort"+  let path = dir ++ "/villefort"+  putStrLn path+  isBuild <- doesFileExist path+  dataDir <- getDataDir+  if isBuild+    then putStrLn "custom buil detected" >> executeFile path True ["--custom",dataDir] Nothing+    else putStrLn "no custom build :("++launch :: VConfig -> IO ()    +launch conf = do      +  _ <- forkIO $ dailyCheck conf+  _ <- forkIO dailyMl+  scotty ( port conf) $ do+    get "/" $ do+      todos <- liftIO  getTodos+      html $ pack $ todos+      +    get "/new" $ do+      page <- liftIO makeNewPage+      html $ pack page+      +    post "/delete" $ do+      rawHtml <- body+      deleteTodo rawHtml+      redirect "/"++    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+      do liftIO $ updateTask sqlId insertTime+      redirect "/"++    post "/add" $ do+      rawBody <-body+      let parse = Data.List.Split.splitOn "&" (show rawBody)+      do liftIO $ print parse+      let rep y = map (\x -> if x == '+' then ' ' else x) y+      let summary = rep $ getIndex parse 0+      let date    = convDate $ getIndex parse 3+      let todoTitle   = rep $ getIndex parse 1+      let todoSubject = rep $ getIndex parse 2+      liftIO $ addTask todoTitle summary date todoSubject+      redirect "/"+  +    get "/time" $ do+      dat <-liftIO $ getSummary+      html $ pack  dat+      +   ++    get "/js-chart-widgets.min.js" $ do+      jsPath <- liftIO $  getDataFileName "js.js"+      file jsPath+      +    get "/stat" $ do+      page <- liftIO $ genStats+      html $ pack page+      

@@ -0,0 +1,87 @@+module Villefort.Stats (genStats,+              makeTable+             )where++import Villefort.Database+import Control.Monad.IO.Class+import Paths_Villefort+import System.Random++-- | Query to get average of subjects+--getAvg :: IO (Maybe [String])+getAvg :: IO [[String]]+getAvg =  makeQuery "select avg(time), Subject from todo  group by Subject order by avg(time) desc"++-- | Query to get sum of subjects+--getSum :: IO (Maybe [String])+getSum :: IO [[String]]+getSum =  makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"++-- | Helper function to generate row of table+makeRow :: [String] -> String+makeRow x =  "<tr> <th>" ++ (x !! 0) ++ "</th> <th>  " ++ (x!! 1) ++ "</th> </tr>"++-- | Generate Table+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>"++-- | Generate stats+{-+genStats :: IO String+genStats = getSubjects >>= \subjects ->  mapM makeGithub subjects >>= \gits -> getAvg >>=+  \avg -> getSum >>= \statsSum -> getDataFileName "templates/header" >>= \x -> liftIO (readFile x) >>= \header -> return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable ["Subject","time"] statsSum) ++ "</html>" ++ (mconcat gits))+-}++genStats :: IO String+genStats = do+  subjects <- getSubjects+  gits <- mapM makeGithub subjects+  avg <- getAvg+  statsSum <- getSum+  x <- getDataFileName "templates/header"+  header <- liftIO (readFile x)+  return (header ++ table ++ (makeTable ["Subject","time"] avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable ["Subject","time"] statsSum) ++ "</html>" ++ (mconcat gits))++  +-- | Library to include for github table+table :: String+table = " <script src='/js-chart-widgets.min.js'></script><h1> avg </h1>"++-- | creates the github like graph from database++makeGithub :: String -> IO String+makeGithub subject = do+  z <-   makeQuery ("select substr(Due,1,10) from todo where subject = '" ++ subject ++ "' and state = 0")+  color <- getColor+  let header = "<h2 id='"++ subject ++ "'> Calendar "++ subject ++ " </h2> <script> new Calendar({ append_to: '" ++ subject ++ "',num_weeks: 51,day_size: 11, data: ["+  let q = Prelude.map (\x -> "['" ++ (x !! 0) ++"',500],") z+  let bot = "  ], color: " ++ color ++ " }); </script>"+  return (header ++ (Prelude.concat q )++  bot)++colors :: [String]+colors = ["'#F44336'"+         ,"'#E91E63'"+         ,"'#9C27B0'"+         ,"'#673AB7'"+         ,"'#3F51B5'"+         ,"'#2196F3'"+         ,"'#03A9F4'"+         ,"'#00BCD4'"+         ,"'#009688'"+         ,"'#4CAF50'"+         ,"'#8BC34A'"+         ,"'#CDDC39'"+         ,"'#FFEB3B'"+         ,"'#FFC107'"+         ,"'#FF9800'"+         ,"'#FF5722'"+         ,"'#795548'"+         ,"'#9E9E9E'"+         ,"'#607D8B'"+         ]++getColor :: IO String+getColor = do+  number <- randomRIO (0, (length $ colors)-1) :: IO Int+  return (colors !! number)+  

@@ -0,0 +1,15 @@+module Villefort.Summary where +import Villefort.Database+import Control.Monad.IO.Class+import Villefort.Todo+import Villefort.Stats++getDone :: IO [[String]]+getDone = makeQuery  "select Title, time  from todo where substr(Due,1,10) = Date('now','localtime') and time != 0"++getSummary :: IO String+getSummary = do+  dat <- liftIO $ getDone+  header <- getHeader+  return ( header ++ (makeTable ["Subject","Time"] dat))+--2017-07-26

@@ -0,0 +1,36 @@+module Villefort.Time  where++import Data.List.Split as S+import Data.Time+import Data.Time.Calendar.OrdinalDate++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+  +unpackStringToDate x = D (read (nums !! 0) :: Integer) (read (nums !! 1) :: Int) (read (nums !! 2) :: Int)+  where nums = S.splitOn "-" $  take 10 x+  +  ++daysUntil date = do+  c <- getCurrentTime+  let (y,m,d) = toGregorian $ utctDay c+  let split = S.splitOn "-" date+  current <- fromZonedTimeToDay <$> show <$> getZonedTime+  let due     = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (split !! 2) :: Int)+  return $ (diffDays  due current) ++getDate :: IO Day+getDate = fromZonedTimeToDay <$> show <$> getZonedTime++getDateD = unpackStringToDate <$> show <$> getZonedTime++getDay :: IO Int+getDay = do+  z <- getDate+  return $ snd $mondayStartWeek z

@@ -0,0 +1,148 @@+module Villefort.Todo  where++import Villefort.Database+import Villefort.Time+import Control.Monad.IO.Class+import Data.List.Split+import Paths_Villefort +import Database.HDBC+++data Row = Row { rid :: Int,+                 title :: String,+                 description :: String,+                 due :: String,+                 subject :: String,+                 time :: Int,+                 pred :: Double+               } deriving (Show)++toRow :: [String] -> Row+toRow x =  Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4)  (read ( x !! 5) :: Int) (read (x !! 6) :: Double)++qetTasks' :: IO [Row]+qetTasks' = do+  x <- makeQuery' "select id, Title, Description, Due, Subject,  sum(time),pred from todo where state=1 group by id order by id"+  return (map toRow x)++convRow' :: [[SqlValue]] -> [[String]]+convRow' dat = Prelude.map (\x -> Prelude.map (\y -> conv' y ) x) dat++--conv h:: SqlValue -> String+conv' :: SqlValue -> String+conv' x = case fromSql x of+  Just y -> fromSql y :: String+  Nothing -> "0"++--makeQuery :: Query -> IO [[String]]+makeQuery' :: String -> IO [[String]]+makeQuery' query = do+  conn <- getDb+  taskRaw <- quickQuery' conn query []+  disconnect conn+  return (convRow' taskRaw)+++merge :: [a] -> [a] -> [a]+merge [] ys = ys+merge (x:xs) ys = x:merge ys xs+++genModal' :: Row -> IO String+genModal' row = if rid row == 1 then return (" ") else do+  let f = due row+  modal <- getModal+  days  <- daysUntil f+  let da = [daysToColor' days ,+            show $ rid row,+            (convTitle $ title row) ++ "Due in " ++  show days,+            show $ rid row,+            title row,+            description row,+            show $ time row,+            show $ Villefort.Todo.pred row,+            "/delete",+            show $ rid row+           ]++  return $ mconcat $  merge modal da+ ++--genModal row =++daysToColor' :: (Num a, Ord a) => a -> String+daysToColor' x = if x < 1 then "btn-due0"+            else if x == 1 then "btn-due1"+            else if x == 2 then "btn-due2"+            else if x == 3 then "btn-due3"+            else if x == 4 then "btn-due4"+            else if x == 5 then "btn-due5"+            else if x == 6 then "btn-due6"+            else "btn-due7"++++convTitle :: String -> String+convTitle longTitle+  | length s1 > 30 = s1+  | length s2 > 30 = s2+  | length s3 > 30 = s3+  | length s4 > 30 = s4+  | otherwise = longTitle+  where splits = (Data.List.Split.splitOn "." longTitle)+        s1 = (splits !! 0)+        s2 = mconcat (take 2 splits)+        s3 = mconcat (take 3 splits)+        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 html from todos+getTodos :: IO String+getTodos = do+  tasks <-  qetTasks'+  --do liftIO $ putStrLn $ show tasks+  modals <- sequence $  genModal' <$>  tasks+  header <- getHeader+  let body = Prelude.concat modals+  return (header ++  body)++getHeader :: IO String+getHeader = do+  headerPath <-getDataFileName "templates/header"+  header <- liftIO $ readFile headerPath+  return header++-- | Delete a done task from database sets state = 0 but it's record is still maintained in the database for the stats page.++deleteTodo :: (Show t, MonadIO m) => t -> m ()+deleteTodo raw = do+    let da   = Data.List.Split.splitOn "&" (show raw)+    let rawid = Data.List.Split.splitOn "=" $  (Prelude.init (da !! 1))+    let sqlId   = read (rawid!! 1) :: Int+    let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)+    let integerTime = read (rawtime !! 1) :: Int+    if  integerTime /= 0 then+      do liftIO $ updateTask sqlId integerTime -- update task time+         liftIO $ delTask sqlId  -- then remove from database+    else  do liftIO $ delTask sqlId -- otherwise just remove from database+    return ()+++delTask :: Int ->  IO ()+delTask sqlId = execQuery "update todo set state = 0 where id = ?" [sqlId]++updateTask :: Int -> Int ->  IO ()+updateTask 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]++addTask ::  String -> String -> String -> String -> IO ()+addTask todoTitle todoSummary 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, todoTitle, todoSummary, date, todoSubject]+  return ()+

@@ -95,6 +95,7 @@ 	 <li><a href="/">Home</a></li> 	 <li><a href="/new">New</a></li> 	 <li><a href="/stat"> Log </a> </li>+	 <li><a href="/time"> Today </a> </li>        </ul> 	</div> 		

@@ -15,6 +15,7 @@           <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">

@@ -1,2 +1,24 @@+import Test.QuickCheck+import Test.QuickCheck.Monadic+--import Test.QuickCheck.Batch+ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = quickCheck prop_commutativeAdd++prop_commutativeAdd :: Integer -> Integer -> Bool+prop_commutativeAdd n m = n + m == m + n+{-+--prop_data :: String -> String -> String -> String -> Bool+dat :: String -> String -> String -> String -> IO Bool+dat w x y z = do+  addTask w x y z+  list <- qetTasks'+  let f = last list+  --putStrLn $ show f+  --putStrLn $ show $ [w,x,y,z]+  return ([title f, description f, due f, subject f] == [w,x,y,z])++prop_dat w x y z = monadicIO $ do+  date <- run (dat w x y z)+  assert date+-}