{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Villefort.Server  where

import Web.Scotty
import Control.Monad.IO.Class
import Control.Concurrent
import Data.List.Split
import Data.Text.Lazy hiding (splitOn,map,concat,head)
import Villefort.Database
import Villefort.Todo
import Villefort.Stats
import Villefort.Definitions
import Paths_Villefort
import Villefort.Ml
import Villefort.Time
import Villefort.Summary
import Villefort.Daily
import System.IO.Strict as S
import System.Environment
import Control.Monad
import Control.Monad.Reader
import System.Process
import System.Directory
import System.Posix.Process

getWeeks ::(MonadReader VConfig m,MonadIO m) =>  m [[[Char]]]
getWeeks = do
  rawSql <- makeQuery "select id, Title from weeks where state = 1 order by Title"
  return $ Prelude.mapM (\x -> [Prelude.head x ,( Prelude.tail (Prelude.last x))]) rawSql


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 splitDate = Data.List.Split.splitOn "%2F" date
              newDate = (splitDate !! 2) ++ "-" ++ (splitDate !! 0) ++ "-" ++ (splitDate !! 1)


-- | makes html for radiobutton
makeRadio :: String -> String
makeRadio x =  "<dd><input type='radio' name='subject' value='"++ x ++ "'> " ++ x ++ "</br> \n"

makeNewPage :: (MonadReader VConfig m, MonadIO m) => m String
makeNewPage = do
  headerPath <-liftIO $  getDataFileName "templates/header"
  htmlHeader <- liftIO $ S.readFile headerPath
  addPath <- liftIO $ getDataFileName "templates/add.html"
  add <- liftIO $ S.readFile addPath
  let splitWeeks = splitOn "?" add
  subjects <- getSubjects
  let radiobuttons =  map makeRadio subjects
  return (htmlHeader ++ (splitWeeks !! 0) ++ (concat radiobuttons) ++ (splitWeeks !! 1))
 
-- | Main function of loop




writeDate :: IO ()
writeDate = do
  date <-  show <$> getDate
  datePath <- getDataFileName "data/date"
  writeFile datePath date

readDate :: IO D
readDate = do
  datePath <- getDataFileName "data/date"
  rawDate <-  S.readFile datePath
  let date = unpackStringToDate rawDate
  return date

writeDay :: IO ()
writeDay = do
  newDay <- show <$> getDay
  datePath <- getDataFileName "data/day"
  writeFile datePath newDay

readDay :: IO Int
readDay = do
  datePath <- getDataFileName "data/day"
  rawDay <- S.readFile datePath
  let int = read rawDay :: Int
  return int
  
checkDay :: D -> D ->Bool
checkDay oldDate currentDate= ((day oldDate) == (day currentDate))
checkMonth :: D -> D -> Bool
checkMonth oldDate currentDate = (month oldDate) == (month currentDate)
checkYear :: D -> D -> Bool
checkYear oldDate currentDate  = (year oldDate)  == (year currentDate)

runDaily :: VConfig -> D -> D -> IO ()
runDaily vconf oldDate currentDate=
  if (checkDay oldDate currentDate) then
    putStrLn "same-day"
  else
    putStrLn "adding-daily" >> do
    dailies <- sequence (daily vconf)
    mapM_ add dailies
    where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) vconf)

    
runMonthly :: D -> D -> IO ()
runMonthly oldDate currentDate = if(checkMonth oldDate currentDate) then
  putStrLn "same-month"
  else
  putStrLn "adding monthly"

runYearly :: D -> D -> IO ()
runYearly oldDate currentDate = if(checkYear oldDate currentDate) then
  putStrLn "same-year"
  else
  putStrLn "adding yearly"


runWeekly :: VConfig -> Int -> Int -> IO ()
runWeekly conf old current = do
  if old /= current
    then do
    let stmt = selector conf (current-1)
    stmts <- sequence stmt
    mapM_ add stmts
    else return ()
    where add = (\x -> if Prelude.null x then return () else runReaderT ( addDaily x) conf)

selector :: (Num a, Eq a) => VConfig -> a -> [IO [String]]
selector  conf x
  | x == 0 = monday lookconf
  | x == 1 = tuesday lookconf
  | x == 2 = wednesday lookconf
  | x == 3 = thursday lookconf
  | x == 4 = friday lookconf
  | x == 5 = saturday lookconf
  | otherwise = sunday lookconf
    where lookconf = weekly conf
  
  
  


--man :: IO ()
man :: VConfig -> IO ()
man conf = do
  oldDate <- readDate
  currentDate <- getDateD
  oldDay <- readDay
  currentDay <- getDay
  runWeekly conf oldDay currentDay
  runDaily conf oldDate currentDate
  writeDate
  writeDay
  threadDelay 18000000
  
dailyCheck :: VConfig -> IO b
dailyCheck conf = forever$  man conf

villefort :: VConfig -> IO ()
villefort conf = do
  args <- getArgs
  case args of
    ["--custom",_] -> putStrLn "custom" >> launch conf 
    ["--recompile"] -> putStrLn "recompiling" >> recompile
    _ -> putStrLn "straight starting " >> do
      if noCustom conf
        then launch conf >> putStrLn "overload"
        else checkCustomBuild >> launch conf

recompile :: IO ()
recompile = do
  dir <- getAppUserDataDirectory "villefort"
  let execPath = dir ++ "/villefort"
      sourcePath = dir ++"/villefort.hs"
  (_,_,_,pid) <- createProcess (proc "/usr/bin/ghc" ["-o",execPath,sourcePath])
  _ <-
    waitForProcess pid
  return ()

checkCustomBuild :: IO ()
checkCustomBuild = do
  dir <- getAppUserDataDirectory "villefort"
  let path = dir ++ "/villefort"
  putStrLn path
  isBuild <- doesFileExist path
  dataDir <- getDataDir
  if isBuild
    then putStrLn "custom buil detected" >> executeFile path True ["--custom",dataDir] Nothing
    else putStrLn "no custom build :("

launch :: VConfig -> IO ()    
launch conf = do      
  _ <- forkIO $ dailyCheck conf
  _ <- forkIO dailyMl
  scotty ( port conf) $ do
    get "/" $ do
      todos <- liftIO $ runReaderT  getTodos conf
      html $ pack $ todos
      
    get "/new" $ do
      page <- liftIO $ runReaderT makeNewPage conf
      html $ pack page
      
    post "/delete" $ do
      rawHtml <- body
      runReaderT (deleteTodo rawHtml) conf
      redirect "/"

    post "/update" $ do
      rawHtml <- body
      let da   = Data.List.Split.splitOn "&" (show rawHtml)
      do liftIO $ print $ show da
      let rawid = Data.List.Split.splitOn "=" $  (Prelude.init (da !! 1))
      let sqlId   = read (rawid!! 1) :: Int
      let rawtime = Data.List.Split.splitOn "=" $ (da !! 0)
      do liftIO $ print rawtime
      let insertTime = read (rawtime !! 1) :: Int
      do liftIO $ runReaderT (updateTask sqlId insertTime) conf
      redirect "/"

    post "/add" $ do
      rawBody <-body
      let parse = Data.List.Split.splitOn "&" (show rawBody)
      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 todoTitle   = rep $ getIndex parse 1
      let todoSubject = rep $ getIndex parse 2
      liftIO $ runReaderT (addTask todoTitle summary date todoSubject) conf
      redirect "/"
  
    get "/time" $ do
      dat <-liftIO $ runReaderT getSummary conf
      html $ pack  dat
       
  

    get "/js-chart-widgets.min.js" $ do 
     jsPath <- liftIO $  getDataFileName "js.js"
     file jsPath
     
    get "/weekly" $ do
      to <- liftIO $ runReaderT weeklyStats conf
      html $ pack to

      
    get "/stat" $ do
      page <- liftIO $runReaderT  genStats conf
      html $ pack page