{-# LANGUAGE FlexibleContexts #-} module Villefort.Todo where import Villefort.Definitions import Villefort.Database import Villefort.Util import Control.Monad.IO.Class import Data.List.Split import Data.ByteString.Lazy hiding (map,length,take,readFile,zip,head) import Paths_Villefort import Database.HDBC import Control.Monad.Reader import Data.List.Split as S import Data.Time daysUntil :: [Char] -> IO Integer daysUntil date = do let splits = S.splitOn "-" date current <- show <$> getZonedTime let due = fromGregorian (read (splits !! 0) :: Integer) (read (splits !! 1) :: Int) (read (splits !! 2) :: Int) let g = S.splitOn "-" current let current = fromGregorian ( read (g !! 0) :: Integer) (read (g !! 1) :: Int) (read (take 2 ( g !! 2)) :: Int) return $ (diffDays due current) data Row = Row { rid :: Int, title :: String, description :: String, due :: String, subject :: String, time :: Int, pred :: Double } deriving (Show,Eq) toRow :: [String] -> Int -> Double -> Row toRow x = Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4) updateTodos :: (MonadReader VConfig m, MonadIO m) => Int -> Int -> m () updateTodos 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] delTask :: (MonadReader VConfig m, MonadIO m) => Int -> m () delTask sqlId = execQuery "update todo set state = 0 where id = ?" [sqlId] -- | returns time spent on task based off of Task id getTime :: (MonadReader VConfig m,MonadIO m) => String -> m Int getTime id = do idval <- makeQuery' $ "select sum(time) from todo where id = " ++ show id pure $ (read ((idval !! 0) !! 0) :: Int) -- | returns Row data structures for each open task qetTasks' :: (MonadReader VConfig m, MonadIO m) => m [Row] qetTasks' = do x <- makeQuery' "select id, Title, Description, Due, Subject, pred from todo where state=1 group by id order by Due" let ids = map head x times <- mapM getTime ids liftIO $ print $ length times let halfRows = (map toRow x) :: [Int -> Double -> Row] liftIO $ print $ length halfRows let z = apply halfRows times return $ apply z [0,0 .. 1] -- | applies a list of functions to a list of values apply :: [t -> a] -> [t] -> [a] apply (x:xs) (y:ys) = [x y] ++ apply xs ys apply [] (_:_) = [] apply [] []= [] convRow' :: [[SqlValue]] -> [[String]] convRow' dat = Prelude.map (\x -> Prelude.map (\y -> conv' y ) x) dat --conv h:: SqlValue -> String conv' :: SqlValue -> String conv' x = case fromSql x of Just y -> fromSql y :: String Nothing -> "0" --makeQuery :: Query -> IO [[String]] -- |makes Query 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) -- | merges two lists merge :: [a] -> [a] -> [a] merge [] ys = ys merge (x:xs) ys = x:merge ys xs -- | generates modal for task based of Row data Structure genModal' :: Row -> IO String genModal' row = if rid row == 1 then return (" ") else do let f = due row modal <- getModal days <- daysUntil f let da = [daysToColor' days , show $ rid row, (convTitle $ title row) ++ "Due in " ++ show days, show $ rid row, title row, description row, show $ time row, show $ Villefort.Todo.pred row, "/delete", show $ rid row ] return $ mconcat $ merge modal da --genModal row = daysToColor' :: (Num a, Ord a) => a -> String daysToColor' x = if x < 1 then "btn-due0" else if x == 1 then "btn-due1" else if x == 2 then "btn-due2" else if x == 3 then "btn-due3" else if x == 4 then "btn-due4" else if x == 5 then "btn-due5" else if x == 6 then "btn-due6" else "btn-due7" convTitle :: String -> String convTitle longTitle | length s1 > 30 = s1 | length s2 > 30 = s2 | length s3 > 30 = s3 | length s4 > 30 = s4 | otherwise = longTitle where splits = (Data.List.Split.splitOn "." longTitle) s1 = (splits !! 0) s2 = mconcat (take 2 splits) s3 = mconcat (take 3 splits) s4 = mconcat (take 4 splits) getModal :: IO [[Char]] --getModal = path >>= \path -> readFile (path ++ "templates/modal.ts") >>= \rawModal -> return (Data.List.Split.splitOn "}" rawModal) getModal = getDataFileName "templates/modal.ts" >>= \path -> readFile path>>= \rawModal -> return (Data.List.Split.splitOn "}" rawModal) -- | Returns html from todos getTodos :: (MonadReader VConfig m, MonadIO m) => m String getTodos = do tasks <- qetTasks' modals <-liftIO $ sequence $ genModal' <$> tasks header <- getHeader theme <- getTheme let body = Prelude.concat modals return (header ++ theme ++ body) -- | support for user defined themes in villefort config getTheme :: (MonadReader VConfig m, MonadIO m) => m String getTheme = do userConfig <- ask let userColor = colors userConfig let mix = zip [0 ..] userColor return $ "" where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n background:" ++ (snd x ) ++ "; \n color: #ffffff; }\n" -- | Delete a done task from database sets state = 0 but it's record is still maintained in the database for the stats page. deleteTodo :: (MonadReader VConfig m, MonadIO m) => ByteString -> m () deleteTodo raw = do let da = Data.List.Split.splitOn "&" (show raw) let rawid = Data.List.Split.splitOn "=" $ (Prelude.init (da !! 1)) let sqlId = read (rawid!! 1) :: Int let rawtime = Data.List.Split.splitOn "=" $ (da !! 0) let integerTime = read (rawtime !! 1) :: Int do updateTodos sqlId integerTime -- update task time if integerTime /= 0 then delTask sqlId -- then remove from database else delTask sqlId -- otherwise just remove from database return ()