{-# LANGUAGE FlexibleContexts #-}
module Villefort.Database 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)
import Data.List.Utils (replace)
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 = replace "''" "'"