{-# 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], Resource))

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

-- |Container type for 'Dispatchable' type class.
data Dispatcher = ∀α. Dispatchable α ⇒ Dispatcher α

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

-- |@a `'mappend'` b@ first tries to find a resource with @a@, and if
-- it returns 'Nothing', tries @b@ next.
instance Monoid Dispatcher where
    {-# INLINE mempty #-}
    mempty = dispatcher ()

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

-- |An IO-based dispatcher returning resource paths as well as
-- 'Resource's.
instance Dispatchable (CI Text
                       → [ByteString]
                       → IO (Maybe ([ByteString], Resource))) where
    dispatch = id

-- |An IO-based dispatcher.
instance Dispatchable (CI Text → [ByteString] → IO (Maybe Resource)) where
    dispatch = ((((<$>) ∘ (<$>)) ((,) []) ∘) ∘)

-- |A pure dispatcher.
instance Dispatchable (CI Text → [ByteString] → Maybe Resource) where
    dispatch = (((return ∘ ((,) [] <$>)) ∘) ∘)

-- |An IO-based dispatcher ignoring host names.
instance Dispatchable ([ByteString] → IO (Maybe Resource)) where
    dispatch = const ∘ (((<$>) ∘ (<$>)) ((,) []) ∘)

-- |A pure dispatcher ignoring host names.
instance Dispatchable ([ByteString] → Maybe Resource) where
    dispatch = const ∘ ((return ∘ ((,) [] <$>)) ∘)

-- |The constant dispatcher returning always the same 'Resource'.
instance Dispatchable Resource where
    dispatch = const ∘ const ∘ return ∘ Just ∘ (,) []

-- |The empty dispatcher returning always 'Nothing'.
instance Dispatchable () where
    dispatch _ _ _ = return Nothing