diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,7 @@ module Main where import Villefort.Server (villefort) -import Villefort.Config +import Villefort.Config (defaultConfig) main :: IO () main = villefort defaultConfig diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,20 @@ # Villefort -Villefort is a task management system written in Haskell. +Villefort is a time management system written in Haskell. -## Version 1.2.17 changes -- fixed subject truncation bug on new todo page. +## Version 1.2.18 +- New json endpoint for active tasks +- Improved logging +- [Emacs Ormode intergration](https://alicereuter.com/posts/Villefort%20Orgmode%20Integration.html) +## json api +added json api to get current active tasks and to time completed today. +``` +alice$ curl localhost:3002/tasks +[{"subject":"cs","due":"2019-04-28","rid":177,"time":0,"title":"cs lab","dueIn":0,"description":""},{"subject":"bio","due":"2019-04-30","rid":176,"time":0,"title":"bio hw","dueIn":2,"description":""},{"subject":"probality","due":"2019-05-01","rid":178,"time":0,"title":"probability hw","dueIn":3,"description":""}] +alice$ curl localhost:3002/done +[{"subject":"bio","time":30,"title":"bio hw"}] +``` +[default config](https://github.com/alicereuter/Villefort/blob/master/src/Villefort/Config.hs) # Home screen ![alt text](https://raw.githubusercontent.com/alicereuter/Villefort/master/data/screen.png) @@ -13,181 +24,67 @@ ![alt text](https://raw.githubusercontent.com/alicereuter/Villefort/master/data/screen02.png) +``` +usage: Villefort [options] + options: + -r, --recompile recompiles Villefort using a custom config file found in ~/.Villefort/villefort.hs + -h, prints this help manual +``` + # To install 1. Install cabal (https://www.haskell.org/platform/) 2. In terminal or command prompt run `cabal install Villefort`. 3. and then `cabal run Villefort`. 4. You will be able to see the home screen by typing localhost:3002 into your favorite browser. -## Configure Villefort -create a custom main method in ~.villefort/villefort.hs -This default config can be found [here](https://github.com/alicereuter/Villefort/blob/master/src/Villefort/Config.hs). -For example -```haskell -module Main where +## Configure your villefort +create a custom main method in ~.villefort/villefort.hs. Below is an example. -import Villefort.Server (villefort) -import Villefort.Config -main :: IO () -main = villefort defaultConfig { - database = "/home/user/todo.db" --usage custom database location - } -``` - -### Task Data Type -#### Definition ```haskell -data Date = Date {year :: String, -- | The specific date you want a task to be due on - month :: String, - day :: String } - | Offset {offset :: Int} -- | The number of days in the future you want the task to be due on - | Today -- | Make the task due today - deriving (Show,Eq) - --- | Villefort's internal representation of Tasks -data Task = Task {title :: String, - description :: String, - subject :: String, - due :: Date} deriving (Show,Eq) - -``` -### Example usage -```haskell -cs121n :: IO Task -cs121n = pure $ Task { - title = "cs121 notes", - description = "Type up cs121 lecture notes", - subject = "cs121", - due = Today} -``` -### Storing Vars in the Database extended example -```haskell module Main where -import Villefort.Server (villefort) -import Villefort.Config (defaultConfig,defWeekly) +import Villefort.Server +import Villefort.Config import Villefort.Definitions -import Villefort.Database -import Control.Monad.Reader import System.Random +import System.IO.Strict as S main :: IO () -main = check >> villefort conf - -conf = defaultConfig { - database= "dotfiles/todo.db" - ,weekly = schedule - } - --- | checks if vars exists and if they don't initialize them with their default value -check :: IO () -check = do - isBack <- runReaderT (isVar "back" ) conf - if isBack then pure () else runReaderT (updateVar "back" (show 5.0)) conf - isCrunch <- runReaderT (isVar "crunch" ) conf - if isBack then pure () else runReaderT (updateVar "crunch" (show 5.0)) conf - - -schedule = defWeekly { - monday = [a121cn - ,eng301n - ,a121chw - ,back - ], - tuesday = [cs101n - ,cs121n - ], - wednesday = [a121cn - ,eng301n - ,a121chw - ,back - ], - thursday = [cs101n - ,cs101hw - ,crunches - ], - friday = [eng301n - ,a121chw - ,back - ], - saturday = [crunches] - } - -cs121hw :: IO Task -cs121hw = pure $ Task {title="cs121 hw", - description="Do cs121hw for Friday", - subject="cs211", - due =Offset 4} -cs101hw :: IO Task -cs101hw = pure $ Task { title ="cs101 hw", - description ="Do cs101hw for Friday", - subject = "cs101", - due = Offset 7} -cs101n :: IO Task -cs101n = pure $ Task { - title = "cs101 notes", - description = "Type up cs101 lecture notes", - subject = "cs101", - due = Today} - -cs121n :: IO Task -cs121n = pure $ defTask { - title = "cs121 notes", - description = "Type up cs121 lecture notes", - subject = "cs121"} - -eng301n :: IO Task -eng301n = pure $ defTask { - title = "eng301 notes", - description = "Type up eng301 lecture notes", - subject = "eng301" - } - -a121chw :: IO Task -a121chw = pure $ defTask { - title = "a121c hw", - description = "Do a121c homework", - subject = "a121c" - } - -a121cn :: IO Task -a121cn = pure $ defTask { - title = "a121c notes", - description = "Type up a121c lecture notes", - subject = "a121c" - } - -cs101 :: IO Task -cs101 = pure $ Task { - title = "cs101 hw", - description = "Do cs101hw for Friday", - subject = "cs101", - due = Offset 7} - -back = exercise "back" 1 -crunches = exercise "crunch" 1 +main = villefort def { + daily = [calendar ], + weekly = defWeekly { + monday = [push], + wednesday = [push], + friday = [push, + scan] + + } + } + +-- description, heading, subject +calendar = pure ["","check calendar","admin"] +scan = pure ["scan notes","scan","admin"] -exercise var increment = do - res <- flip runReaderT conf $ getVar var - putStrLn $ show res - let num = read res :: Double - flip runReaderT conf (updateVar var ( show ( num+increment))) - listB <- gener num - return $ Task var ("do " ++ show listB++ " " ++ var) "exercise" Today +-- | 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"] -gener :: Double -> IO [Int] -gener level = do +pushUps level = do dubs <- mapM gen $ replicate 5 level :: IO [Double] return $ map floor dubs where gen x = randomRIO (x-(x/3),x+(x/3)) + ``` - 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 migrate between versions of Villefort. +## How to copy data between versions of Villefort. 1. Install the new version through cabal. 2. Navigate to ~/.cabal . 3. Navigate to share/ . diff --git a/Villefort.cabal b/Villefort.cabal --- a/Villefort.cabal +++ b/Villefort.cabal @@ -1,12 +1,12 @@ name: Villefort -version: 0.1.2.17 +version: 0.1.2.18 synopsis: Villefort is a task manager and time tracker -description: Villefort is a browser based time tracker built around a sqlite3 database. +description: Villefort is a web based time tracker built around a portable sqlite3 database. homepage: https://github.com/alicereuter/Villefort#readme license: BSD3 license-file: LICENSE author: Alice Reuter -maintainer: alicereuterdev@gmail.com +maintainer: alice@alicereuter.com copyright: 2017 Alice Reuter category: Web build-type: Simple @@ -22,6 +22,7 @@ , templates/boot.css , templates/jqui.css , templates/bs.js + library hs-source-dirs: src other-modules: Paths_Villefort @@ -56,6 +57,7 @@ , MissingH , convertible , uri-encode + , aeson default-language: Haskell2010 @@ -72,7 +74,6 @@ , text , time , random - , mtl default-language: Haskell2010 test-suite Villefort-test diff --git a/data/todo.db b/data/todo.db Binary files a/data/todo.db and b/data/todo.db differ diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs --- a/src/Villefort/Daily.hs +++ b/src/Villefort/Daily.hs @@ -47,7 +47,6 @@ if notrun then return () else do - putStrLn addText todo ← sequence' (extract vconf) :: IO [Task] mapM_ (add vconf) todo where notrun = (extractInt oldDate == extractInt currentDate) @@ -60,7 +59,7 @@ let stmt = selector vconf (current-1) stmts <- sequence' stmt mapM_ (add vconf) stmts - else putStrLn "didn't run weekly" + else pure () add :: VConfig -> Task -> IO () add conf x = runReaderT ( addDaily x) conf diff --git a/src/Villefort/Database.hs b/src/Villefort/Database.hs --- a/src/Villefort/Database.hs +++ b/src/Villefort/Database.hs @@ -52,7 +52,7 @@ makeTable path = do isTable <- varTableExists path - if not isTable then putStrLn "[var] inserting var table for upgrade to Villefort 0.1.2.15 this will only run once" >> constructTable path else pure () + if not isTable then putStrLn "[var] inserting var table for switch in table format from Villefort 0.1.2.15 this will only run once" >> constructTable path else pure () -- | gets list of subjects from local database @@ -185,7 +185,8 @@ -- | 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" +getDone = makeQuery "select Title, time,Subject from todo where substr(Due,1,10) = Date('now','localtime') and time != 0" + -- | rudimentary sanitization diff --git a/src/Villefort/Server.hs b/src/Villefort/Server.hs --- a/src/Villefort/Server.hs +++ b/src/Villefort/Server.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts,DeriveGeneric #-} module Villefort.Server (villefort) where import Web.Scotty (scotty @@ -8,19 +8,20 @@ ,body ,redirect ,html + ,json ,param ,file) import Control.Monad.Reader (liftIO,runReaderT) import Control.Concurrent (forkIO) import Data.Text.Lazy (pack) import Villefort.Database -import Villefort.Todo (deleteTodo,getTodos,updateTodos) +import Villefort.Todo (deleteTodo,getTodos,updateTodos,qetTasks',Task(..),daysUntil) 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 Paths_Villefort (getDataFileName,getDataDir) import Villefort.Today (getSummary) import Data.List.Split (splitOn) import System.Environment (getArgs) @@ -28,7 +29,13 @@ import System.Directory (getAppUserDataDirectory,doesFileExist) import System.Posix.Process (executeFile) import Data.String.Utils (replace) +import Data.Aeson (Value(..),object,(.=),toJSON) +import Data.Aeson.Types (toJSONList) import Network.URI.Encode (decode) +import Data.String (fromString) +import GHC.Exts (fromList) +import GHC.Generics +import Data.Aeson -- | parses value from raw html post form getIndex :: [[Char]] -> Int -> [Char] @@ -43,17 +50,19 @@ -- | Entry point for server attempts to recompile if needed villefort :: VConfig -> IO () villefort conf = do + -- | update table if necessary let path = database conf - makeTable path args <- getArgs case args of - ["--custom",_] -> putStrLn "custom" >> launch conf - ["--recompile"] -> putStrLn "recompiling" >> recompile - _ -> putStrLn "straight starting " >> do + ["--custom",_] -> putStrLn "launched custom" >> launch conf + ["--recompile"] -> re + ["-r"] -> re + ["-h"] -> putStrLn "usage: Villefort [options] " >> putStrLn " options:" >> putStrLn " -r, --recompile recompiles Villefort using a custom config file found in ~/.Villefort/villefort.hs" >> putStrLn " -h, prints this help manual" + _ -> do if noCustom conf - then launch conf >> putStrLn "overload" + then launch conf else checkCustomBuild >> launch conf - + where re = putStrLn "recompiling" >> recompile -- | recompiles villefort by calling ghc expects .villefort/villefort.hs in home directory recompile :: IO () recompile = do @@ -108,10 +117,10 @@ rawBody <-body let parse = Data.List.Split.splitOn "&" (show rawBody) let clean = replace "+" " " - let summary = clean . decode $ getIndex parse 0 + let summary = clean . Network.URI.Encode.decode $ getIndex parse 0 let date = convDate $ getIndex parse 3 - let todoTitle = clean . decode $ getIndex parse 1 - let todoSubject = clean . decode $ getIndex parse 2 + let todoTitle = clean . Network.URI.Encode.decode $ getIndex parse 1 + let todoSubject = clean . Network.URI.Encode.decode $ getIndex parse 2 liftIO $ runReaderT (addTask todoTitle summary date todoSubject) conf redirect "/" @@ -119,6 +128,7 @@ dat <-liftIO $ runReaderT getSummary conf html $ pack dat + get "/templates/:asset" $ do asset <- param "asset" path <- liftIO $ getDataFileName $ "templates/" ++ asset @@ -131,3 +141,20 @@ get "/log" $ do page <- liftIO $runReaderT genStats conf html $ pack page + + -- | get json active tasks + get "/tasks" $ do + tasks <- liftIO $ runReaderT qetTasks' conf + Web.Scotty.json $ toJSON tasks + + -- | get time done today + get "/done" $ do + dat <- liftIO $ runReaderT getDone conf + let encoded = map (\x -> Done (x !! 0) (read (x !! 1) :: Integer) (x !! 2)) dat :: [Done] + Web.Scotty.json $ toJSON encoded + +data Done = Done {title :: String, + time :: Integer, + subject :: String} deriving (Show,Eq,Generic) +instance FromJSON Done +instance ToJSON Done diff --git a/src/Villefort/Today.hs b/src/Villefort/Today.hs --- a/src/Villefort/Today.hs +++ b/src/Villefort/Today.hs @@ -10,7 +10,8 @@ getSummary :: (MonadReader VConfig m, MonadIO m) => m String getSummary = do dat <- getDone + let cleaned = map (\x -> [x !! 0, x!! 1]) dat header <- getHeader - return ( header ++ (makeTable ["Subject","Time"] $ dat ++ [["Total", show$ total dat]])) + return ( header ++ (makeTable ["Subject","Time"] $ cleaned ++ [["Total", show$ total dat]])) diff --git a/src/Villefort/Todo.hs b/src/Villefort/Todo.hs --- a/src/Villefort/Todo.hs +++ b/src/Villefort/Todo.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE FlexibleContexts #-} -module Villefort.Todo (getTodos,getTheme,subject,updateTodos,deleteTodo) where +{-# LANGUAGE FlexibleContexts,DeriveGeneric #-} +module Villefort.Todo (getTodos,getTheme,subject,updateTodos,deleteTodo,qetTasks',Task(..),daysUntil) where import Villefort.Definitions (VConfig(..)) import Villefort.Database (execQuery,getDb) @@ -10,15 +10,21 @@ import Database.HDBC (SqlValue,fromSql,quickQuery',disconnect) import Control.Monad.Reader (MonadReader,MonadIO,liftIO,ask) import Data.Time (getZonedTime,fromGregorian,diffDays) +import Data.Aeson +import GHC.Generics data Task = Task {rid :: Int, title :: String, description :: String, due :: String, subject :: String, - time :: Int - } deriving (Show,Eq) + time :: Int, + dueIn :: Integer + } deriving (Show,Eq,Generic) +instance FromJSON Task +instance ToJSON Task + -- | difference betweeen the current day and the supplied day daysUntil :: [Char] -> IO Integer daysUntil date = do @@ -30,7 +36,7 @@ return $ (diffDays dateWhenDue currentDate) -- | Used to create row takes time spent as an integer -toRow :: [String] -> Int -> Task +--toRow :: [String] -> Int -> Task toRow x = Task (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4) -- | update the time taken on a certain project @@ -52,16 +58,16 @@ qetTasks' = do x <- makeQuery' "select id, Title, Description, Due, Subject, pred from todo where state=1 group by id order by Due" let ids = map head x - times <- mapM getTime ids - let halfRows = (map toRow x) :: [Int -> Task] - return $ apply halfRows times + times <- mapM getTime ids + let dues = map (\x -> x !! 3) x + dueIn <- liftIO $ mapM daysUntil dues + let halfRows = (map toRow x) :: [Int -> Integer -> Task] + return $ apply halfRows times dueIn -- | 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 (_:_) [] = [] +apply :: [Int -> Integer -> Task] -> [Int] -> [Integer] -> [Task] +apply (x:xs) (y:ys) (z:zs) = [x y z] ++ apply xs ys zs +apply _ _ _ = [] convRow' :: [[SqlValue]] -> [[String]] convRow' dat = Prelude.map (\x -> Prelude.map (\y -> conv' y ) x) dat @@ -91,10 +97,9 @@ genModal' row = if rid row == 1 then return (" ") else do let f = due row modal <- getModal - days <- daysUntil f - let da = [daysToColor' days , + let da = [daysToColor' $ dueIn row , show $ rid row, - (convTitle $ title row) ++ "Due in " ++ show days, + (convTitle $ title row) ++ "Due in " ++ ( show $ dueIn row), show $ rid row, title row, description row,