Network/HTTP/Lucu/Parser.hs

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