{-# LANGUAGE FlexibleContexts #-} module Villefort.Todo where import Villefort.Database import Villefort.Time import Villefort.Definitions import Control.Monad.IO.Class import Data.List.Split import Data.ByteString.Lazy hiding (map,length,take,readFile,zip) import Paths_Villefort import Database.HDBC import Control.Monad.Reader data Row = Row { rid :: Int, title :: String, description :: String, due :: String, subject :: String, time :: Int, pred :: Double } deriving (Show) toRow :: [String] -> Row toRow x = Row (read (x !! 0) :: Int) (x !! 1) (x !! 2) (x !! 3)( x !! 4) (read ( x !! 5) :: Int) (read (x !! 6) :: Double) qetTasks' :: (MonadReader VConfig m, MonadIO m) => m [Row] qetTasks' = do x <- makeQuery' "select id, Title, Description, Due, Subject, sum(time),pred from todo where state=1 group by id order by Due" return (map toRow x) 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]] 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) merge :: [a] -> [a] -> [a] merge [] ys = ys merge (x:xs) ys = x:merge ys xs 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) 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" getHeader :: (MonadReader VConfig m, MonadIO m) => m String getHeader = do headerPath <- liftIO $ getDataFileName "templates/header" liftIO $ readFile headerPath -- | 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 updateTask sqlId integerTime -- update task time if integerTime /= 0 then delTask sqlId -- then remove from database else delTask sqlId -- otherwise just remove from database return ()