{-# LANGUAGE NamedFieldPuns #-}

module Network.Loli.Engine where

import Control.Monad.State hiding (join)
import Data.Default
import Data.List (find)
import Data.Maybe
import Hack
import Hack.Contrib.Middleware.NotFound
import Hack.Contrib.Response
import Hack.Contrib.Utils hiding (get, put)
import MPS
import Network.Loli.Config
import Network.Loli.Config
import Prelude hiding ((.), (/), (>), (^))

type RoutePath = (RequestMethod, String, AppUnit)
type EnvFilter = Env -> Env
type ResponseFilter = Response -> Response
type Param = (String, String)
data AppState = AppState
  {
    env :: Env
  , response :: Response
  }

instance Default AppState where
  def = AppState def def

type AppUnitT a = StateT AppState IO a
type AppUnit = AppUnitT ()

run_app :: AppUnit -> Application
run_app unit = \env -> execStateT unit def {env} ^ response

router :: [RoutePath] -> Middleware
router h app' = \env'' ->
  let path             = env''.path_info
      script           = env''.script_name
      mod_env location = env'' 
        { scriptName  = script ++ location
        , pathInfo    = path.drop (location.length)
        }
  in
  case h.find (match_route env'') of
    Nothing -> app' env''
    Just (_, template, app_state) -> do
      let (location, params) = parse_params template path .fromJust
      run_app app_state (mod_env location .merge_captured params)
  where
    match_route env' (method, template, _) = 
      env'.request_method.is method 
        && env'.path_info.parse_params template .isJust
    merge_captured params env' =
      let loli_captures = params.map_fst (loli_captures_prefix ++)
          new_hack_headers = env'.custom ++ loli_captures
      in
      env' {hackHeaders = new_hack_headers}
      

parse_params :: String -> String -> Maybe (String, [(String, String)])
parse_params t s =
  let template_tokens = t.split "/"
      url_tokens = s.split "/"
  in
  if url_tokens.length < template_tokens.length
    then Nothing
    else 
      let rs = zipWith capture template_tokens url_tokens
      in
      if rs.all isJust
        then 
          let location = url_tokens.take (template_tokens.length).join "/"
          in
          Just $ (location, rs.map fromJust.filter isJust.map fromJust)
        else Nothing
  
  where
    capture x y 
      | x.starts_with ":" = Just $ Just (x.tail, y)
      | x == y = Just Nothing
      | otherwise = Nothing
    
  

data Loli = Loli
  {
    routes :: [RoutePath]
  , middlewares :: [Middleware]
  , mimes :: [(String, String)]
  }

instance Default Loli where
  def = Loli def def def

type UnitT a = State Loli a
type Unit = UnitT ()



loli :: Unit -> Application
loli unit = run unit (not_found empty_app)
  where
    run :: Unit -> Middleware
    run unit' = 
      let s           = execState unit' def
          paths       = s.routes
          
          loli_app    = router paths
          mime_filter = lookup_mime (s.mimes)
          stack       = s.middlewares.use
          pre         = pre_installed_middlewares.use
      in
      use [pre, mime_filter, stack, loli_app]

update :: (MonadState a m, Functor m) => (a -> a) -> m ()
update f = get ^ f >>= put

insert_last :: a -> [a] -> [a]
insert_last x xs = xs ++ [x]

add_route :: RoutePath -> Loli -> Loli
add_route r s = let xs = s.routes in s {routes = xs.insert_last r}

route :: RequestMethod -> String -> AppUnit -> Unit
route r s u = update $ add_route (r, s, u)

add_middleware :: Middleware -> Loli -> Loli
add_middleware x s = 
  let xs = s.middlewares in s {middlewares = xs.insert_last x}

add_mime :: String -> String -> Loli -> Loli
add_mime k v s = let xs = s.mimes in s {mimes = xs.insert_last (k, v)}

update_response :: ResponseFilter -> AppUnit
update_response f = update $ \s -> let x = s.response.f in s {response = x}

set_response :: Response -> AppUnit
set_response r = update_response $ const r

get_response :: AppUnitT Response
get_response = get ^ response

update_env :: EnvFilter -> AppUnit
update_env f = update $ \s -> let x = s.env.f in s {env = x}

get_env :: AppUnitT Env
get_env = get ^ env

-- middleware
lookup_mime :: [(String, String)] -> Middleware
lookup_mime h app env = do
  r <- app env
  case h.only_fst.find mime >>= flip lookup h of
    Nothing -> return r
    Just v -> return $ r.set_content_type v
  where mime x = env.path_info.ends_with ('.' : x)