Network/HTTP/Lucu/Parser.hs

   1 {-# LANGUAGE
   2     UnicodeSyntax
   3   #-}
   4 -- |A set of auxiliary parser utilities.
   5 module Network.HTTP.Lucu.Parser
   6     ( atMost
   7     , finishOff
   8     , skipManyTill
   9     , skipWhile1
  10     , skipSpace1
  11     , isAlphaNum
  12     )
  13     where
  14 import Control.Applicative
  15 import Control.Applicative.Unicode
  16 import Control.Monad.Unicode
  17 import Data.Attoparsec.Char8
  18 import Prelude.Unicode
  19
  20 -- |@'atMost' n v@ is like @'P.many' v@ but accumulates @v@ at most
  21 -- @n@ times.
  22 atMost ∷ Alternative f ⇒ Int → f α → f [α]
  23 {-# INLINEABLE atMost #-}
  24 atMost 0 _ = pure []
  25 atMost n v = ( (:) <$> v ⊛ atMost (n-1) v )
  26              <|>
  27              pure []
  28
  29 -- |@'finishOff' p@ is equivalent to @p '>>=' \\a -> 'endOfInput' '>>'
  30 -- 'return' a@.
  31 finishOff ∷ Parser α → Parser α
  32 {-# INLINE finishOff #-}
  33 finishOff = ((endOfInput *>) ∘ return =≪)
  34
  35 -- |Similar to 'manyTill' but discards the result.
  36 skipManyTill ∷ Alternative f ⇒ f α → f β → f ()
  37 {-# INLINEABLE skipManyTill #-}
  38 skipManyTill p end = go
  39     where
  40       go = (end *> pure ()) <|> (p *> go)
  41
  42 -- |Similar to 'skipWhile' but consumes at least one character.
  43 skipWhile1 ∷ (Char → Bool) → Parser ()
  44 {-# INLINE skipWhile1 #-}
  45 skipWhile1 p = takeWhile1 p *> pure ()
  46
  47 -- |Similar to 'skipSpace' but consumes at least one whitespace.
  48 skipSpace1 ∷ Parser ()
  49 {-# INLINE skipSpace1 #-}
  50 skipSpace1 = skipMany1 space
  51
  52 -- |@'isAlphaNum' c@ returns 'True' iff @'isDigit' c ||
  53 -- 'isAlpha_ascii' c@.
  54 isAlphaNum ∷ Char → Bool
  55 {-# INLINE isAlphaNum #-}
  56 isAlphaNum c = isDigit c ∨ isAlpha_ascii c