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' :: 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"
getHeader :: (MonadReader VConfig m, MonadIO m) => m String
getHeader = do
headerPath <- liftIO $ getDataFileName "templates/header"
liftIO $ readFile headerPath
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
if integerTime /= 0 then
delTask sqlId
else delTask sqlId
return ()