{-# 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]
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)
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]
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' :: SqlValue -> String
conv' x = case fromSql x of
Just y -> fromSql y :: String
Nothing -> "0"
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
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 = getDataFileName "templates/modal.ts" >>= \path -> readFile path>>= \rawModal -> return (Data.List.Split.splitOn "}" rawModal)
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 $ "<style>" ++ (mconcat $ map genSelector mix) ++ "</style>"
where genSelector x = ".btn-due" ++ show (fst x) ++ "{ \n background:" ++ (snd x ) ++ "; \n color: #ffffff; }\n"
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
if integerTime /= 0 then
delTask sqlId
else delTask sqlId
return ()