{-# LANGUAGE
    ExistentialQuantification
  , FlexibleInstances
  , UnicodeSyntax
  #-}
-- |FIXME: doc
module Network.HTTP.Lucu.Resource.Dispatcher
    ( Dispatchable(..)
    , Dispatcher
    )
    where
import Control.Applicative
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.Monoid
import Data.Text (Text)
import Network.HTTP.Lucu.Resource.Internal
import Prelude.Unicode

-- |FIXME: docs
class Dispatchable α where
    dispatch ∷ α
             → CI Text
             → [ByteString]
             → IO (Maybe ([ByteString], ResourceDef))

    dispatcher ∷ α → Dispatcher
    {-# INLINE dispatcher #-}
    dispatcher = Dispatcher

-- |FIXME: doc
data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α

instance Dispatchable Dispatcher where
    dispatch (Dispatcher α) = dispatch α
    dispatcher = id

-- |FIXME: doc
instance Monoid Dispatcher where
    {-# INLINE mempty #-}
    mempty = dispatcher (return Nothing ∷ IO (Maybe ResourceDef))

    {-# INLINEABLE mappend #-}
    mappend (Dispatcher α) (Dispatcher β)
        = dispatcher
          $ \host path → do r ← dispatch α host path
                            case r of
                              Just _  → return r
                              Nothing → dispatch β host path

instance Dispatchable (CI Text
                       → [ByteString]
                       → IO (Maybe ([ByteString], ResourceDef))) where
    dispatch = id

instance Dispatchable (CI Text → [ByteString] → IO (Maybe ResourceDef)) where
    dispatch = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘)

instance Dispatchable (CI Text → [ByteString] → Maybe ResourceDef) where
    dispatch = (((return ∘ ((,) [] <$>)) ∘) ∘)

instance Dispatchable ([ByteString] → IO (Maybe ResourceDef)) where
    dispatch = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘)

instance Dispatchable ([ByteString] → Maybe ResourceDef) where
    dispatch = const ∘ ((return ∘ ((,) [] <$>)) ∘)

instance Dispatchable (IO (Maybe ResourceDef)) where
    dispatch = const ∘ const ∘ ((<$>) ∘ (<$>)) ((,) [])

instance Dispatchable ResourceDef where
    dispatch = const ∘ const ∘ return ∘ Just ∘ (,) []