Villefort (empty) → 0.1.0.0
raw patch · 10 files changed
+388/−0 lines, 10 filesdep +FindBindep +HDBCdep +HDBC-sqlite3setup-changed
Dependencies added: FindBin, HDBC, HDBC-sqlite3, Villefort, base, mtl, scotty, split, text, time
Files
- LICENSE +30/−0
- README.md +9/−0
- Setup.hs +2/−0
- Villefort.cabal +56/−0
- app/Main.hs +106/−0
- src/Database.hs +36/−0
- src/Lib.hs +6/−0
- src/Stats.hs +28/−0
- src/Todo.hs +113/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Chris Reuter (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Chris Reuter nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# Villefort +Villefort is a time managment system written in Haskell and backed by sqlite. +#Home screen + +# Villefort has page to add new todos + +# Villefort also a stats page which shows how much time you spend on each subject as well as github like time tracker + +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Villefort.cabal view
@@ -0,0 +1,56 @@+name: Villefort+version: 0.1.0.0+synopsis: Villefort is a task manager and time tracker written in haskell.+description: It is based off of a sqlite database and has the ability to add new tasks+homepage: https://github.com/Chrisr850/Villefort#readme+license: BSD3+license-file: LICENSE+author: Chris Reuter+maintainer: creuter@lsoc.org+copyright: 2017 Chris Reuter+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Lib+ , Database+ , Todo+ , Stats+ build-depends: base >= 4.7 && < 5+ , HDBC+ , HDBC-sqlite3+ , split+ , time+ , FindBin+ , mtl+ default-language: Haskell2010++executable Villefort+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base+ , Villefort+ , scotty+ , HDBC-sqlite3+ , HDBC+ , split+ , text+ , time+ default-language: Haskell2010++test-suite Villefort-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , Villefort+ ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/Chrisr850/Villefort
+ app/Main.hs view
@@ -0,0 +1,106 @@+{-# 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)+import Data.Time+import Database+import Todo+import Stats+++++getDone = makeQuery "select Title, time from todo where due = Date('now','+1 day') 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+++convDate :: String -> String+convDate date = newDate+ where split = Data.List.Split.splitOn "%2F" date+ newDate = (split !! 2) ++ "-" ++ (split !! 0) ++ "-" ++ (split !! 1)++++makeRadio x = "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"+ ++makeNewPage = do+ path <- path+ rawhtml <- liftIO $ readFile (path ++ "templates/add.html")+ let split = splitOn "?" rawhtml+ subjects <- getSubjects+ let radiobuttons = map makeRadio subjects+ return ((split !! 0) ++ (concat radiobuttons) ++ (split !! 1))+ + +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+ stmt <- liftIO $ prepare conn "insert into todo (Description,Title,Entered,Due,State,time,Subject) Values (?,?,current_date,?,1,0,?)"+ do liftIO $ execute stmt [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 $ path+ file (path ++ "js.js")+ + get "/stat" $ do+ page <- liftIO $ genStats+ html $ pack page
+ src/Database.hs view
@@ -0,0 +1,36 @@+{-# 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++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 =fmap (\x -> (x !! 0) ++ "Villefort/") $ (Data.List.Split.splitOn "Villefort/") <$> getProgPath++getDb :: IO Connection +getDb = (++ "data/todo.db") <$> path >>= \path -> putStrLn path >> connectSqlite3 path++conv :: [[SqlValue]] -> [[String]]+conv dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String) x) dat++makeQuery :: Query -> IO [[String]]+makeQuery query = getDb >>= \conn -> quickQuery' conn query [] >>=+ \taskRaw -> disconnect conn >> return ( conv taskRaw)++ ++execQuery :: Query -> [Int] -> IO ()+execQuery query params = getDb >>= \conn -> prepare conn query >>=+ \stmt -> execute stmt ( map toSql params) >> commit conn >> disconnect conn
+ src/Lib.hs view
@@ -0,0 +1,6 @@+module Lib+ ( someFunc+ ) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"
+ src/Stats.hs view
@@ -0,0 +1,28 @@+module Stats where+import Database+import Control.Monad.IO.Class++data Query = Query String++getAvg = makeQuery "select avg(time), Subject from todo group by Subject order by avg(time) desc"++getSum = makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"++makeRow x = "<tr> <th>" ++ (x !! 0) ++ "</th> <th> " ++ (x!! 1) ++ "</th> </tr>"++makeTable stats = "<table style='width:100%'>" ++ (mconcat (map makeRow stats)) ++ "</table>"+++genStats = getSubjects >>= mapM makeGithub >>= \gits -> getAvg >>=+ \avg -> getSum >>= \sum -> return (hea ++ (makeTable avg) ++ "</br> <h1> Sum </h1>" ++ (makeTable sum) ++ "</html>" ++ (mconcat gits))++hea :: String+hea = "<!DOCTYPE html> <html> <script src='/js-chart-widgets.min.js'></script><h1> avg </h1>"++makeGithub :: String -> IO String+makeGithub subject = do+ z <- makeQuery ("select Due from todo where subject = '" ++ subject ++ "' and state = 0")+ 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: '#005500' }); </script>"+ return (head ++ (Prelude.concat q )++ bot)
+ src/Todo.hs view
@@ -0,0 +1,113 @@+module Todo where++import Database+import Data.List.Split+import Control.Monad.IO.Class+import Data.Time++data Row = Row { rid :: Int,+ title :: String,+ description :: String,+ due :: String,+ time :: Int+ } deriving (Show)++toRow :: [String] -> Row+toRow x = Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3) (read( x !! 4) :: Int)++qetTasks' = makeQuery "select id, Title, Description, Due, time from todo where state = 1 order by Due" >>=+ \x -> return (map toRow x)++++++merge [] ys = ys+merge (x:xs) ys = x:merge ys xs+++ +genModal' row = 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,+ "/delete",+ show $ time row,+ 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)++daysTilDue date = do+ c <- getCurrentTime+ let (y,m,d) = toGregorian $ utctDay c+ let split = Data.List.Split.splitOn "-" date+ let current = fromGregorian y m d+ let due = fromGregorian (read (split !! 0) :: Integer) (read (split !! 1) :: Int) (read (split !! 2) :: Int)+ return $ (diffDays due current) -1+++getTodos = do+ tasks <- qetTasks'+ path <- path + modals <- sequence $ Prelude.map genModal' tasks+ header <- readFile (path ++ "templates/index.html")+ let body = Prelude.concat modals+ return (header ++ body)++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 "update todo set time = time + ? where id = ?" [ time, id]
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"