{-# 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) -- | gets list of subjects from local database getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String] getSubjects = (\x-> (!! 0) <$> x) <$> makeQuery "select Subject from todo where state = 0 group by Subject" -- | get paths tests for --custom flag to allow for executing custom builds 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 -- | connects to database checks if custom database path is set 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 -- | converts from sqlValues to Strings convRow :: [[SqlValue]] -> [[String]] convRow dat = Prelude.map (\x -> Prelude.map (\y -> fromSql y :: String ) x) dat -- | takes sqlQuery and returns results as a 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) -- | executes a query that changes values in database 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 -- | gets the task id for the next avaible todo 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 -- | adds new task sanitizes input to avoid SQL escaping 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)] -- | logs new daily entry due on same day 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 -- | 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" -- | rudimentary sanitization clean :: String -> String clean = replace "''" "'"