-- A simplistic Happstack-based server for static files.

module Main where

import Happstack.Server
import Control.Monad
import Control.Monad.Trans
import Data.Maybe
import Prelude hiding (putStrLn)
import System.FilePath
import System.Environment.UTF8
import System.IO hiding (putStrLn, hPutStrLn)
import System.IO.UTF8
import System.Directory
import System.Exit

usage :: String -> IO ()
usage prog = hPutStrLn stderr $ "Usage: " ++ prog ++ " port_number files_dir"

mbNumber :: (Read a, Integral a) => String -> Maybe a
mbNumber k = do
  let r = readsPrec 0 k
  case r of
    [] -> Nothing
    (m:ms) -> Just (fst m)

main :: IO ()
main = do
  prog <- getProgName
  args <- getArgs
  when (length args < 2) $ do usage prog >> exitWith (ExitFailure (-1))
  let [portc, stdir] = take 2 args
      mbport :: Maybe Int
      mbport = mbNumber portc
  when (mbport == Nothing) $ do
    hPutStrLn stderr $ prog ++ ": " ++ portc ++ " is not a valid port number"
    usage prog
    exitWith (ExitFailure (-2))
  let port = fromJust mbport
  de <- doesDirectoryExist stdir
  when (not de) $ do
    hPutStrLn stderr $ prog ++ ": " ++ stdir ++ " does not exist or is not a directory"
    usage prog
    exitWith (ExitFailure (-3))
  simpleHTTP (Conf port Nothing) $ myFileServeStrict [] stdir

myFileServeStrict ps p = do
  rq <- askRq
  liftIO $ hPutStrLn stderr $ rqUri rq
  fileServeStrict ps p