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.ArrowList
  15 import Control.Arrow.ArrowKleisli
  16 import Control.Arrow.List
  17 import Control.Monad.IO.Class
  18 import Control.Monad.Unicode
  19 import Prelude.Unicode
  20
  21 -- |FIXME: doc
  22 newtype MonadIO m ⇒ Router m α β
  23     = Router {
  24         unRouter ∷ ListTArrow m α β
  25       }
  26     deriving ( Arrow
  27              , ArrowKleisli m
  28              , ArrowZero
  29              , ArrowList
  30              , ArrowPlus
  31              , ArrowChoice
  32              , ArrowApply
  33              , Category
  34              )
  35
  36 -- |FIXME: doc
  37 runRouter ∷ (Applicative m, MonadIO m) ⇒ Router m α β → α → m (Maybe β)
  38 {-# INLINEABLE runRouter #-}
  39 runRouter = ((optional' =≪) ∘) ∘ runListTArrow ∘ unRouter
  40     where
  41       optional' ∷ Applicative f ⇒ [β] → f (Maybe β)
  42       {-# INLINE optional' #-}
  43       optional' []    = pure Nothing
  44       optional' (x:_) = pure (Just x)