-qvalue = do x ← char '0'
- xs ← option "" $
- do y ← char '.'
- ys ← atMost 3 digit
- return (y:ys)
- return $ read (x:xs)
- <|>
- do x ← char '1'
- xs ← option "" $
- do y ← char '.'
- ys ← atMost 3 (char '0')
- return (y:ys)
- return $ read (x:xs)
-
--- |@'atMost' n v@ is like @'P.many' v@ but applies the given action
--- at most @n@ times.
-atMost ∷ Alternative f ⇒ Int → f a → f [a]
-{-# INLINE atMost #-}
-atMost 0 _ = pure []
-atMost n v = ( (:) <$> v ⊛ atMost (n-1) v )
- <|>
- pure []
-
-
-data CharAccumState
- = CharAccumState {
- casChunks ∷ !(S.Seq BS.ByteString)
- , casLastChunk ∷ !(S.Seq Char)
- }
-
-instance Monoid CharAccumState where
- mempty
- = CharAccumState {
- casChunks = (∅)
- , casLastChunk = (∅)
- }
- mappend a b
- = b {
- casChunks = (casChunks a ⊳ lastChunk a) ⋈ casChunks b
- }
-
-lastChunk ∷ CharAccumState → BS.ByteString
-{-# INLINE lastChunk #-}
-lastChunk = BS.pack ∘ toList ∘ casLastChunk
-
-snoc ∷ CharAccumState → Char → CharAccumState
-{-# INLINEABLE snoc #-}
-snoc cas c
- | S.length (casLastChunk cas) ≥ LS.defaultChunkSize
- = cas {
- casChunks = casChunks cas ⊳ lastChunk cas
- , casLastChunk = S.singleton c
- }
- | otherwise
- = cas {
- casLastChunk = casLastChunk cas ⊳ c
- }
-
-finish ∷ CharAccumState → LS.ByteString
-{-# INLINEABLE finish #-}
-finish cas
- = let chunks = toList $ casChunks cas ⊳ lastChunk cas
- str = LS.fromChunks chunks
- in
- str
-
-manyCharsTill ∷ ∀m b. (Monad m, Alternative m)
- ⇒ m Char
- → m b
- → m LS.ByteString
-{-# INLINEABLE manyCharsTill #-}
-manyCharsTill p end = scan (∅)
- where
- scan ∷ CharAccumState → m LS.ByteString
- {-# INLINE scan #-}
- scan s
- = (end *> pure (finish s))
- <|>
- (scan =≪ (snoc s <$> p))