Network/HTTP/Lucu/Router.hs

   1 {-# LANGUAGE
   2     GeneralizedNewtypeDeriving
   3   , UnicodeSyntax
   4   #-}
   5 -- |FIXME: doc
   6 module Network.HTTP.Lucu.Router
   7     ( Router
   8     , runRouter
   9     )
  10     where
  11 import Control.Applicative
  12 import Control.Category
  13 import Control.Arrow
  14 import Control.Arrow.ArrowKleisli
  15 import Control.Arrow.List
  16 import Data.Maybe
  17 import Control.Monad.IO.Class
  18 import Prelude.Unicode
  19
  20 -- |FIXME: doc
  21 newtype Router m α β
  22     = Router {
  23         unRouter ∷ ListTArrow m α β
  24       }
  25     deriving ( Arrow
  26              , ArrowKleisli m
  27              , ArrowZero
  28              , ArrowPlus
  29              , ArrowChoice
  30              , ArrowApply
  31              , Category
  32              )
  33
  34 -- |FIXME: doc
  35 runRouter ∷ (Applicative m, MonadIO m) ⇒ Router m α β → α → m (Maybe β)
  36 {-# INLINE runRouter #-}
  37 runRouter = ((listToMaybe <$>) ∘) ∘ runListTArrow ∘ unRouter