{-# LANGUAGE OverloadedStrings #-} module Main where import Web.Scotty import Data.Char import Control.Monad.IO.Class import Database.HDBC.Sqlite3 import Database.HDBC import Data.List.Split import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Text.Lazy hiding (splitOn,map,concat) import Data.Time import Database import Todo import Stats import Paths_Villefort getDone = makeQuery "select Title, time from todo where due = Date('now','localtime') and state = 0" getWeeks = do raw <- makeQuery "select id, Title from weeks where state = 1 order by Title" return $ Prelude.mapM (\x -> [Prelude.head x ,( Prelude.tail (Prelude.last x))]) raw getIndex :: [[Char]] -> Int -> [Char] getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1 -- | Converts date from Javascript to sqlite date fromat convDate :: String -> String convDate date = newDate where split = Data.List.Split.splitOn "%2F" date newDate = (split !! 2) ++ "-" ++ (split !! 0) ++ "-" ++ (split !! 1) -- | makes html for radiobutton makeRadio x = "
" ++ x ++ "
\n" makeNewPage = do path <- getDataFileName "templates/add.html" rawhtml <- liftIO $ readFile path let split = splitOn "?" rawhtml subjects <- getSubjects let radiobuttons = map makeRadio subjects return ((split !! 0) ++ (concat radiobuttons) ++ (split !! 1)) -- | Main function of loop main :: IO () main = do scotty 3002 $ do get "/" $ do todos <- liftIO getTodos html $ pack $ todos get "/new" $ do page <- liftIO makeNewPage html $ pack page post "/delete" $ do raw <- body deleteTodo raw redirect "/" post "/update" $ do raw <- body let da = Data.List.Split.splitOn "&" (show raw) do liftIO $ print $ show da let rawid = Data.List.Split.splitOn "=" $ (Prelude.init (da !! 1)) let id = read (rawid!! 1) :: Int let rawtime = Data.List.Split.splitOn "=" $ (da !! 0) do liftIO $ print rawtime let time = read (rawtime !! 1) :: Int do liftIO $ updateTask id time redirect "/" post "/add" $ do raw <-body conn <- liftIO $ getDb let parse = Data.List.Split.splitOn "&" (show raw) do liftIO $ print parse let rep y = map (\x -> if x == '+' then ' ' else x) y let summary = rep $ getIndex parse 0 let date = convDate $ getIndex parse 3 let title = rep $ getIndex parse 1 let subject = rep $ getIndex parse 2 stmt <- liftIO $ prepare conn "insert into todo (Description,Title,Entered,Due,State,time,Subject) Values (?,?,current_date,?,1,0,?)" do liftIO $ execute stmt [toSql title,toSql summary,toSql date,toSql subject] do liftIO $ commit conn do liftIO $ disconnect conn redirect "/" get "/time" $ do dat <- liftIO $ getDone html $ pack $ ("

Shit I've done today

" ++ (show dat)) get "/js-chart-widgets.min.js" $ do path <- liftIO $ getDataFileName "js.js" file path get "/stat" $ do page <- liftIO $ genStats html $ pack page