{-# LANGUAGE FlexibleContexts #-} module Villefort.Database where import Control.Monad.IO.Class import Control.Monad.Reader import Database.HDBC.Sqlite3 import Database.HDBC import Data.List.Split import System.Environment import Paths_Villefort import Villefort.Definitions type Query = String type Path = String type Subject = String getSubjects :: (MonadReader VConfig m, MonadIO m) => m [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' :: (MonadReader VConfig m, MonadIO m) => m FilePath path' = do env <- ask let s = showDatabase env args <- liftIO $ getArgs let cont = do if length args > 1 then if args !! 0 == "--custom" then return $ args !! 1 else liftIO $ getDataDir else liftIO $ getDataDir if s then (liftIO $ putStrLn =<< getDataDir) >> cont else cont getDb :: (MonadReader VConfig m, MonadIO m) => m Connection --getDb = (++ "/data/todo.db") <$> liftIO path' >>= \path -> liftIO $ connectSqlite3 path getDb = do path <- path' let fullpath = (path ++ "/data/todo.db") liftIO $ connectSqlite3 fullpath --convRow :: [[SqlValue]] -> [[String]] convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat --makeQuery :: Query -> IO [[String]] makeQuery :: (MonadReader VConfig m, MonadIO m) => String -> m [[String]] makeQuery query = do conn <- getDb taskRaw <- liftIO $ quickQuery' conn query [] liftIO $ disconnect conn return (convRow taskRaw) {- makeQuery query = getDb >>= \conn -> quickQuery' conn query [] >>= \taskRaw -> disconnect conn >> return ( convRow taskRaw) -} --execQuery :: (MonadReader VConfig m, MonadIO m) => Query -> [a] -> m () execQuery query params = getDb >>= \conn -> liftIO $ prepare conn query >>= \stmt -> execute stmt ( map toSql params) >> commit conn >> disconnect conn getNextId :: (MonadReader VConfig m, MonadIO m) => m Integer getNextId = do f <- makeQuery "select id from todo order by id desc" let rawid = head $ f let id = (read (rawid !! 0) :: Integer) +1 return id delTask :: (MonadReader VConfig m, MonadIO m) => Int -> m () delTask sqlId = execQuery "update todo set state = 0 where id = ?" [sqlId] updateTask :: (MonadReader VConfig m, MonadIO m) => Int -> Int -> m () 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 :: (MonadReader VConfig m, MonadIO m) => String -> String -> String -> String -> m () 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 () addDaily :: (MonadReader VConfig m, MonadIO m) => [String] -> m () 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 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" getDoneDay :: (MonadReader VConfig m, MonadIO m) =>String -> m [[String]] getDoneDay day = makeQuery $ "select Title, time from todo where substr(Due,1,10) = '"++ day ++ "' and time != 0" -- | Query to get average of subjects --getAvg :: IO (Maybe [String]) getAvg :: (MonadReader VConfig m, MonadIO m) => m [[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 :: (MonadReader VConfig m, MonadIO m) => m [[String]] getSum = makeQuery "select sum(time), Subject from todo group by Subject order by sum(time) desc"