{-# LANGUAGE
    GeneralizedNewtypeDeriving
  , UnicodeSyntax
  #-}
-- |FIXME: doc
module Network.HTTP.Lucu.Router
    ( Router
    , runRouter
    )
    where
import Control.Applicative
import Control.Category
import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowKleisli
import Control.Arrow.List
import Control.Monad.IO.Class
import Control.Monad.Unicode
import Prelude.Unicode

-- |FIXME: doc
newtype MonadIO m ⇒ Router m α β
    = Router {
        unRouter ∷ ListTArrow m α β
      }
    deriving ( Arrow
             , ArrowKleisli m
             , ArrowZero
             , ArrowList
             , ArrowPlus
             , ArrowChoice
             , ArrowApply
             , Category
             )

-- |FIXME: doc
runRouter ∷ (Applicative m, MonadIO m) ⇒ Router m α β → α → m (Maybe β)
{-# INLINEABLE runRouter #-}
runRouter = ((optional' =≪) ∘) ∘ runListTArrow ∘ unRouter
    where
      optional' ∷ Applicative f ⇒ [β] → f (Maybe β)
      {-# INLINE optional' #-}
      optional' []    = pure Nothing
      optional' (x:_) = pure (Just x)