
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

import Happstack.Lite
import Control.Concurrent.STM.Lifted
import Control.Monad.STM (retry)
import Control.Monad.State.Lazy
import System.Process
import Text.Read hiding (get)
import Data.Either (lefts, rights)
import Data.Time
import System.Directory
import Text.Blaze.Html5
import Data.Monoid
import System.Environment
import Control.Monad.Catch
import Control.Concurrent.Async.Lifted
import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value)
import qualified Text.Blaze.Html5.Attributes as A
import Prelude hiding (head)
import Data.Text hiding (head)
import System.Exit
import System.Random.Shuffle

template :: Text -> Html -> Response
template title' body' = toResponse $ html $ do
	head $ do
		title (toHtml title')
	body $ do
		body'
		p $ a ! href "/radio/upload" $ "back home"
		p $ a ! href "rtmp://cyberia.onl/radio/play" $ "play"
		p $ a ! href "https://github.com/Volafile-sekrit-prokekt/radio/issues" $ "report problems and request features"

realFile ('.' : xs) = False
realFile [] = False
realFile _ = True

try' x = do
	result <- try $ x
	case result of
		Left (_ :: SomeException) -> return False
		Right _ -> return True

main :: IO ()
main = do
	--[convdir, playdir] <- getArgs
	let convdir = "/tmp/conv"
	let playdir = "/tmp/play"

	initalFiles <- do
		oldfiles <- getDirectoryContents convdir
		sequence $ do
			file <- oldfiles
			guard $ realFile file
			return $ try' $ removeFile $ convdir <> "/" <> file

		files <- getDirectoryContents playdir
		let parsed = do
			file <- files
			guard $ realFile file
			return $ case readsPrec 0 file of
				[] -> Left file
				(_ :: UTCTime, name) : xs -> Right (file, name)
		sequence $ do
			fileName <- lefts parsed
			return $ try' $ removeFile $ playdir ++ "/" ++ fileName
		return $ rights parsed

	fileList <- newTVarIO []

	async $ flip runStateT initalFiles $ forever $ do
		old <- get
		files <- (shuffleM =<<) $ atomically $ do
			new <- readTVar fileList
			writeTVar fileList []
			case new <> old of
				[] -> retry
				_ -> return $ new <> old
		put files
		sequence $ do
			(file, name) <- files
			return $ do
				ecode <- liftIO $ waitForProcess <=< spawnCommand $ "avconv -v 0 -re -i \"" <> playdir <> "/" <> file <> "\" -vn -c:a copy -f flv rtmp://localhost/radio/play"
				case ecode of
					ExitSuccess -> return ()
					ExitFailure _ -> liftIO $ void $ try' $ removeFile $ playdir ++ "/" ++ file
		return ()

	convq <- newTQueueIO
	async $ forever $ do
		(file, name) <- atomically $ readTQueue convq
		proc <- spawnCommand $ "avconv -v 0 -i \"" <> convdir <> "/" <> file <> "\" -vn -c:a libfdk_aac -vbr 4 \"" <> convdir <> "/" <> file <> ".aac\""
		ecode <- waitForProcess proc
		try' $ removeFile (convdir ++ "/" ++ file)
		case ecode of
			ExitSuccess -> do
				copied <- try' $ copyFile (convdir ++ "/" ++ file ++ ".aac") (playdir ++ "/" ++ file)
				if copied
					then atomically $ do
						new <- readTVar fileList
						writeTVar fileList (new ++ [(file, show name)])
					else
						void $ try' $ removeFile (playdir ++ "/" ++ file)
			ExitFailure _ -> return ()
		try' $ removeFile (convdir ++ "/" ++ file ++ ".aac")

	serve (Just $ ServerConfig 10100 30000000 30000000 "/tmp") $ do
		dir "radio" $ dir "upload" $ do
			let uploadForm = do
				method GET
				ok $ template "upload form" $ do
					form ! enctype "multipart/form-data" ! A.method "POST" ! action "/radio/upload" $ do
						input ! type_ "file" ! name "file_upload" ! size "40"
						input ! type_ "submit" ! value "upload"
			let handler = do
				(tmpFile, uploadName, contentType) <- lookFile "file_upload"
				liftIO $ do
					time <- getCurrentTime
					let convFile = show time <> uploadName
					copied <- try' $ copyFile tmpFile $ convdir ++ "/" ++ convFile
					if copied
						then atomically $ writeTQueue convq (convFile, uploadName)
						else void $ try' $ removeFile $ convdir ++ "/" ++ convFile
				ok $ template "file uploaded" $ do
					p $ "lel"
			uploadForm <> handler

