-{-# INLINEABLE runRouter #-}
-runRouter = ((optional' =≪) ∘) ∘ runListTArrow ∘ unRouter
- where
- optional' ∷ Applicative f ⇒ [β] → f (Maybe β)
- {-# INLINE optional' #-}
- optional' [] = pure Nothing
- optional' (x:_) = pure (Just x)
+{-# INLINE runRouter #-}
+runRouter = ((listToMaybe <$>) ∘) ∘ runListTArrow ∘ unRouter
+
+-- |FIXME: doc
+anyScheme ∷ Arrow (⇝) ⇒ URI ⇝ (Host, Path)
+{-# INLINEABLE anyScheme #-}
+anyScheme = arr uriHost &&& arr uriPathSegments
+
+-- |FIXME: doc
+schemeWith ∷ (ArrowChoice (⇝), ArrowZero (⇝))
+ ⇒ (CIAscii → Bool)
+ → URI ⇝ (Host, Path)
+{-# INLINEABLE schemeWith #-}
+schemeWith f
+ = proc uri →
+ if f (uriCIScheme uri) then
+ anyScheme ⤙ uri
+ else
+ zeroArrow ⤙ (⊥)
+
+-- |@'scheme' s@ = @'schemeWith' ('==' s)@
+scheme ∷ (ArrowChoice (⇝), ArrowZero (⇝)) ⇒ CIAscii → URI ⇝ (Host, Path)
+{-# INLINE scheme #-}
+scheme = schemeWith ∘ (≡)
+
+-- |@'http' = 'scheme' \"http\" '<+>' 'scheme' \"https\"@
+http ∷ (ArrowChoice (⇝), ArrowPlus (⇝), ArrowZero (⇝)) ⇒ URI ⇝ (Host, Path)
+{-# INLINE http #-}
+http = scheme "http" <+> scheme "https"
+
+-- |@'http'' = 'scheme' \"http\"@
+http' ∷ (ArrowChoice (⇝), ArrowZero (⇝)) ⇒ URI ⇝ (Host, Path)
+http' = scheme "http"
+
+-- |@'https' = 'scheme' \"https\"@
+https ∷ (ArrowChoice (⇝), ArrowZero (⇝)) ⇒ URI ⇝ (Host, Path)
+https = scheme "https"