summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAliceReuter <>2019-04-29 02:59:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-04-29 02:59:00 (GMT)
commitc30a5084066016acb04b452ac69ce971abe00f57 (patch)
tree2f46008c4ba2f576a44f42868b52552bdb6a657c
parentfcd8dbc571e1cb6bb4905d8cbe85afe97d759ac6 (diff)
version 0.1.2.180.1.2.18
-rw-r--r--Main.hs2
-rw-r--r--README.md207
-rw-r--r--Villefort.cabal9
-rw-r--r--data/todo.dbbin122880 -> 122880 bytes
-rw-r--r--src/Villefort/Daily.hs3
-rw-r--r--src/Villefort/Database.hs5
-rw-r--r--src/Villefort/Server.hs51
-rw-r--r--src/Villefort/Today.hs3
-rw-r--r--src/Villefort/Todo.hs37
9 files changed, 124 insertions, 193 deletions
diff --git a/Main.hs b/Main.hs
index 62ccf8a..bfb5faf 100644
--- 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
index f6adce2..fd64e32 100644
--- 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 @@ Villefort is a task management system written in Haskell.
![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
-
-import Villefort.Server (villefort)
-import Villefort.Config
-
-main :: IO ()
-main = villefort defaultConfig {
- database = "/home/user/todo.db" --usage custom database location
- }
-```
+## Configure your villefort
+create a custom main method in ~.villefort/villefort.hs. Below is an example.
-### 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
-
-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
-
-gener :: Double -> IO [Int]
-gener level = do
+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"]
+
+-- | 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"]
+
+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
index 434a15b..4bc372b 100644
--- 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 @@ data-files: data/todo.db
, templates/boot.css
, templates/jqui.css
, templates/bs.js
+
library
hs-source-dirs: src
other-modules: Paths_Villefort
@@ -56,6 +57,7 @@ library
, MissingH
, convertible
, uri-encode
+ , aeson
default-language: Haskell2010
@@ -72,7 +74,6 @@ executable Villefort
, text
, time
, random
- , mtl
default-language: Haskell2010
test-suite Villefort-test
diff --git a/data/todo.db b/data/todo.db
index efcf38c..5641e19 100644
--- a/data/todo.db
+++ b/data/todo.db
Binary files differ
diff --git a/src/Villefort/Daily.hs b/src/Villefort/Daily.hs
index f8434c8..a7b3fc8 100644
--- a/src/Villefort/Daily.hs
+++ b/src/Villefort/Daily.hs
@@ -47,7 +47,6 @@ runCheck vconf oldDate currentDate extract extractInt addText =
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 @@ runWeekly vconf old current = do
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
index da647a5..47d5c14 100644
--- a/src/Villefort/Database.hs
+++ b/src/Villefort/Database.hs
@@ -52,7 +52,7 @@ constructTable path = do
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 @@ fmtDate y m d =fmt y ++ "-" ++ fmt m ++ "-" ++ fmt d
-- | 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
index a783bc6..1687481 100644
--- 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 @@ import Web.Scotty (scotty
,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.Process (createProcess,proc,waitForProcess)
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 @@ convDate date = newDate
-- | 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 @@ launch conf = do
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 @@ launch conf = do
dat <-liftIO $ runReaderT getSummary conf
html $ pack dat
+
get "/templates/:asset" $ do
asset <- param "asset"
path <- liftIO $ getDataFileName $ "templates/" ++ asset
@@ -131,3 +141,20 @@ launch conf = do
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
index ffa2969..62178fb 100644
--- a/src/Villefort/Today.hs
+++ b/src/Villefort/Today.hs
@@ -10,7 +10,8 @@ import Villefort.Util (getHeader,makeTable,total)
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
index 2d22c00..221c114 100644
--- 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,14 +10,20 @@ 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)
+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
@@ -30,7 +36,7 @@ daysUntil date = do
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' :: (MonadReader VConfig m, MonadIO m) => m [Task]
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' :: Task -> 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 ,
+ 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,