Villefort 0.1.2.17 → 0.1.2.18
raw patch · 9 files changed
+122/−191 lines, 9 filesdep +aesondep ~mtl
Dependencies added: aeson
Dependency ranges changed: mtl
Files
- Main.hs +1/−1
- README.md +50/−153
- Villefort.cabal +5/−4
- data/todo.db binary
- src/Villefort/Daily.hs +1/−2
- src/Villefort/Database.hs +3/−2
- src/Villefort/Server.hs +39/−12
- src/Villefort/Today.hs +2/−1
- src/Villefort/Todo.hs +21/−16
Main.hs view
@@ -1,7 +1,7 @@ module Main where import Villefort.Server (villefort)-import Villefort.Config+import Villefort.Config (defaultConfig) main :: IO () main = villefort defaultConfig
README.md view
@@ -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  @@ -13,181 +24,67 @@  +``` +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/ .
Villefort.cabal view
@@ -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
data/todo.db view
binary file changed (122880 → 122880 bytes)
src/Villefort/Daily.hs view
@@ -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
src/Villefort/Database.hs view
@@ -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
src/Villefort/Server.hs view
@@ -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
src/Villefort/Today.hs view
@@ -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]]))
src/Villefort/Todo.hs view
@@ -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,