{-# 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 import Data.String.Utils 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" getSubjects :: (MonadReader VConfig m, MonadIO m) => m [String] 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 = 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 :: 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 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" -- | Query to get average of subje -- | Query to get sum of subjects --getSum :: IO (Maybe [String]) clean = id --replace "'" "''"