Parsers.hs

{-# LANGUAGE OverloadedStrings #-}

-- | Miscellaneous git-related attoparsec 'Data.Attoparsec.ByteString.Parsers'.

module Data.Git.Internal.Parsers where

import           Control.Applicative
import           Control.Monad                    (void)
import           Data.Attoparsec.ByteString       as A
import qualified Data.Attoparsec.ByteString.Char8 as A8
import           Data.Attoparsec.ByteString.Lazy  as AL
import           Data.Bits
import qualified Data.ByteString                  as B
import qualified Data.ByteString.Lazy             as BL
import           Data.Word

import Data.Git.Hash
import Data.Git.Types

space, nullByte, lf, lt :: Parser ()
-- | Parse a newline.
lf       = void $ word8 0x0a
-- | Parse a less-than (@<@)
lt       = void $ word8 0x3c
-- | Parse a space.
space    = void $ word8 0x20
-- | Parse a null byte.
nullByte = void $ word8 0x00

-- | Parse lowercase hex digits.
lcHex :: Parser Word8
lcHex = satisfy isLcHex <?> "lowercase-hex"
    where isLcHex n = 48 <= n && n <= 57  || 97 <= n && n <= 102


-- | Parse an EOL or the end of the input.
eol :: Parser ()
eol = void A8.endOfLine <|> A.endOfInput

-- FIXME
-- | Parse a 'Word32'
word32 :: Parser Word32
word32 = do (a,b,c,d) <- (,,,) <$> anyWord8 <*> anyWord8 <*> anyWord8 <*> anyWord8
            return $ fromIntegral d
                     .|. fromIntegral c `unsafeShiftL` 8
                     .|. fromIntegral b `unsafeShiftL` 16
                     .|. fromIntegral a `unsafeShiftL` 24

-- FIXME
-- | Parse a 'Word64'
word64 :: Parser Word64
word64 = do (a,b,c,d,e,f,g,h) <- (,,,,,,,) <$> anyWord8 <*> anyWord8 <*> anyWord8 <*> anyWord8
                                          <*> anyWord8 <*> anyWord8 <*> anyWord8 <*> anyWord8
            return $ fromIntegral h
                     .|. fromIntegral g `unsafeShiftL` 8
                     .|. fromIntegral f `unsafeShiftL` 16
                     .|. fromIntegral e `unsafeShiftL` 24
                     .|. fromIntegral d `unsafeShiftL` 32
                     .|. fromIntegral c `unsafeShiftL` 40
                     .|. fromIntegral b `unsafeShiftL` 48
                     .|. fromIntegral a `unsafeShiftL` 56

-- | Skip text until EOL.
skipLine :: Parser ()
skipLine = A.skipWhile (/=0x0a) <* eol

-- | Parse a binary 'Sha1'.
parseSha1 :: Parser Sha1
parseSha1 =  Sha1 <$> A.take 20

-- | Parse a 40-byte hex SHA into a 'Sha1'.
parseSha1Hex :: Parser Sha1
parseSha1Hex = fromHex . Sha1Hex . B.pack <$> A.count 40 lcHex

-- TODO: Just parse from back to front.
-- | Parse a 'Contact'.
parseContact :: Parser Contact
parseContact = makeContact <$> parseName <* lt <*> takeTill (==0x3e) <* anyWord8 <* space
    where parseName = do n <- takeTill (==0x3c)
                         return . maybe n fst $ B.unsnoc n

-- | Parse a 'Date'.
parseDate :: Parser Date
parseDate = (,) <$> A8.decimal <* space <*> takeTill (==0x0a) <* lf

-- | Run a 'Parser', giving back 'Nothing' on failure.
parseMaybe :: Parser a -> BL.ByteString -> Maybe a
parseMaybe p b = AL.maybeResult $ AL.parse p b