{-# LANGUAGE TemplateHaskell #-}
module Schedooler.Internal where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.PSQueue
import Data.Time

data Task = Task { name :: String
                 , action :: IO ()
                 , frequency :: String }

instance Eq Task where
    (Task n1 _ f1) == (Task n2 _ f2) = n1 == n2 && f1 == f2
    _ == _ = False

instance Ord Task where
    (Task _ _ f1) `compare` (Task _ _ f2) = LT

instance Show Task where
    show (Task n _ f) = "Task " ++ n ++ " " ++ show f

-- Task should be the key, not the priority, duh
type Q = PSQ Task String

data Schedule = Schedule { threadId :: TVar (Maybe ThreadId)
                         , queue :: TVar Q
                         }


addTask :: Task -> Schedule -> STM Schedule
addTask task schedule = do
    modifyTVar (queue schedule) (insert task (frequency task))
    return schedule

newQ :: IO Schedule
newQ = do
    q <- newTVarIO Data.PSQueue.empty
    tid <- newTVarIO Nothing

    return $ Schedule tid q

start :: Schedule -> IO ()
start (Schedule t q) = do
    mtid <- readTVarIO t

    case mtid of
        Just _ -> putStrLn "Already running"
        Nothing -> do
            tid <- forkIO (loop q)
            atomically $ writeTVar t (Just tid)

stop :: Schedule -> IO ()
stop (Schedule t _) = do
    mtid <- readTVarIO t

    case mtid of
        Just tid -> do
            killThread tid
            atomically $ writeTVar t Nothing
        Nothing -> putStrLn "Not running"

simpleAdd :: IO () -> Schedule -> IO ()
simpleAdd a s = do
    let task = Task "action" a "1 second"
    void $ atomically $ addTask task s

loop :: TVar Q -> IO ()
loop tq = do
    q <- readTVarIO tq

    let tasks = map key $ toList q

    forM_ tasks action

    putStrLn $ "tasks executed: " ++ show q

    threadDelay 1000000

    loop tq


pinsert x [] = [x]
pinsert x (y:ys) = if x < y then x:y:ys
                           else y:(pinsert x ys)
