{-# LANGUAGE FlexibleContexts #-}
module Villefort.Database (makeQuery
,getSubjects
,execQuery
,addDaily
,clean
,getDone
,getDb
,addTask) where
import Control.Monad.Reader (MonadIO,MonadReader,liftIO,ask)
import Database.HDBC.Sqlite3 (Connection,connectSqlite3)
import Database.HDBC (SqlValue
,execute
,commit
,disconnect
,toSql
,fromSql
,quickQuery'
,prepare)
import System.Environment (getArgs)
import Paths_Villefort (getDataDir)
import Villefort.Definitions (VConfig(..))
import Data.Convertible.Base (Convertible)
getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String]
getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject"
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 = do
env <- ask
let dat = database env
let isDat = not $ null $ dat
if isDat then liftIO $ connectSqlite3 dat else 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 :: (MonadReader VConfig m, MonadIO m) => String -> m [[String]]
makeQuery query = do
conn <- getDb
taskRaw <- liftIO $ quickQuery' conn query []
liftIO $ disconnect conn
return (convRow taskRaw)
execQuery :: (Convertible a SqlValue,
MonadIO m,
MonadReader VConfig m) => String -> [a] -> m ()
execQuery query params = do
conn <- getDb
stmt <- liftIO $ prepare conn query
_ <- ($) liftIO $ execute stmt (map toSql params)
_ <- ($) liftIO $ commit conn
liftIO $ 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
pure $ (read (rawid !! 0) :: Integer) +1
addTask :: (MonadReader VConfig m, MonadIO m) => String -> String -> String -> String -> m ()
addTask todoSummary todoTitle 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, (clean todoSummary),(clean todoTitle), date, (clean todoSubject)]
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"
clean :: String -> String
clean = id