module Network.HTTP.Lucu.Resource
    ( ResourceDef(..)
    , Resource
    , ResTree
    , mkResTree    -- [ ([String], ResourceDef) ] -> ResTree
    , findResource -- ResTree -> URI -> Maybe ResourceDef
    , runResource  -- ResourceDef -> Interaction -> IO ThreadId
    )
    where

import           Control.Concurrent
import           Control.Monad.Reader
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.ByteString.Lazy.Char8 (ByteString)
import           Data.List
import qualified Data.Map as M
import           Data.Map (Map)
import           Network.HTTP.Lucu.Interaction
import           Network.HTTP.Lucu.Utils
import           Network.URI


type Resource a = ReaderT Interaction IO a


{- /aaa/bbb/ccc にアクセスされた時、もし /aaa/bbb に貪欲なリソースがあ
   れば、假に /aaa/bbb/ccc に何らかのリソースがあったとしても必ず
   /aaa/bbb が撰ばれる。/aaa/bbb のリソースが貪欲でなければ、それは無視
   される。 -}
data ResourceDef = ResourceDef {
      resUsesNativeThread :: Bool
    , resIsGreedy         :: Bool
    , resResource         :: Resource ()
    }
type ResTree    = ResNode -- root だから Map ではない
type ResSubtree = Map String ResNode
data ResNode    = ResNode (Maybe ResourceDef) ResSubtree


mkResTree :: [ ([String], ResourceDef) ] -> ResTree
mkResTree list = processRoot list
    where
      processRoot :: [ ([String], ResourceDef) ] -> ResTree
      processRoot list
          = let (roots, nonRoots) = partition (\ (path, _) -> path == []) list
                children = processNonRoot nonRoots
            in
              if null roots then
                  -- / にリソースが定義されない。/foo とかにはあるかも。
                  ResNode Nothing children
              else
                  -- / がある。
                  let (_, def) = last roots
                  in 
                    ResNode (Just def) children

      processNonRoot :: [ ([String], ResourceDef) ] -> ResSubtree
      processNonRoot list
          = let subtree    = M.fromList [(name, node name)
                                             | name <- childNames]
                childNames = [name | (name:_, _) <- list]
                node name  = let defs = [def | (path, def) <- list, path == [name]]
                             in
                               if null defs then
                                   -- この位置にリソースが定義されない。
                                   -- もっと下にはあるかも。
                                   ResNode Nothing children
                               else
                                   -- この位置にリソースがある。
                                   ResNode (Just $ last defs) children
                children   = processNonRoot [(path, def)
                                                 | (_:path, def) <- list, not (null path)]
            in
              subtree


findResource :: ResTree -> URI -> Maybe ResourceDef
findResource (ResNode rootDefM subtree) uri
    = let pathStr = uriPath uri
          path    = [x | x <- splitBy (== '/') pathStr, x /= ""]
      in
        if null path then
            rootDefM
        else
            walkTree subtree path
    where
      walkTree :: ResSubtree -> [String] -> Maybe ResourceDef

      walkTree subtree (name:[])
          = case M.lookup name subtree of
              Nothing               -> Nothing
              Just (ResNode defM _) -> defM

      walkTree subtree (x:xs)
          = case M.lookup x subtree of
              Nothing                      -> Nothing
              Just (ResNode defM children) -> case defM of
                                                Just (ResourceDef { resIsGreedy = True })
                                                    -> defM
                                                _   -> walkTree children xs


runResource :: ResourceDef -> Interaction -> IO ThreadId
runResource def itr = fork $ runReaderT rsrc itr -- FIXME: 例外をcatch
    where
      fork = if (resUsesNativeThread def)
             then forkOS
             else forkIO
      rsrc = resResource def