{-

This file is part of the Haskell package playlists. It is subject to
the license terms in the LICENSE file found in the top-level directory
of this distribution and at git://pmade.com/playlists/LICENSE. No part
of playlists package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | Helper functions for @Attoparsec@ and @ByteString@.
module Text.Playlist.Internal.Attoparsec
       ( isEOL
       , isEq
       , skipEq
       , skipSpace
       , skipLine
       ) where

--------------------------------------------------------------------------------
import Data.Attoparsec.ByteString
import Data.Word (Word8)
import Data.Word8 (isSpace)

--------------------------------------------------------------------------------
-- | True if the given @Word8@ is an end of line character.
isEOL :: Word8 -> Bool
isEOL :: Word8 -> Bool
isEOL Word8
x = Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13

--------------------------------------------------------------------------------
-- | True if the given @Word8@ is an equal sign.
isEq :: Word8 -> Bool
isEq :: Word8 -> Bool
isEq = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
61)

--------------------------------------------------------------------------------
-- | Skip an equal sign and any space around it.
skipEq :: Parser ()
skipEq :: Parser ()
skipEq = Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Bool) -> Parser ()
skip Word8 -> Bool
isEq Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace

--------------------------------------------------------------------------------
-- | Skip all whitespace.
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = (Word8 -> Bool) -> Parser ()
skipWhile Word8 -> Bool
isSpace

--------------------------------------------------------------------------------
-- | Skip all characters up to and including the next EOL.
skipLine :: Parser ()
skipLine :: Parser ()
skipLine = (Word8 -> Bool) -> Parser ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isEOL) Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace