Lexer.x

{
{-# OPTIONS -w #-}
module HOpenPGP.Tools.Lexer
( alexEOF
, alexSetInput
, alexGetInput
, alexError
, alexScan
, ignorePendingBytes
, alexGetStartCode
, runAlex
, Alex(..)
, Token(..)
, AlexReturn(..)
, AlexPosn(..)
) where

import Prelude hiding (lex)
import Numeric (readHex)
import Codec.Encryption.OpenPGP.Types (TwentyOctetFingerprint(..), EightOctetKeyId(..))

}

%wrapper "monad"

$digit = 0-9
$hexdigit = [0-9A-Fa-f]

tokens :-
  $white+ ;
  a { lex' TokenA }
  and { lex' TokenAnd }
  any { lex' TokenAny }
  every { lex' TokenEvery }
  not { lex' TokenNot }
  one { lex' TokenOne }
  or { lex' TokenOr }
  subkey { lex' TokenSubkey }
  tag { lex' TokenTag }
  of { lex' TokenOf }
  \=\= { lex' TokenEq }
  \= { lex' TokenEq }
  equals { lex' TokenEq }
  \< { lex' TokenLt }
  \> { lex' TokenGt }
  \( { lex' TokenLParen }
  \) { lex' TokenRParen }
  contains { lex' TokenContains }
  pkversion { lex' TokenPKVersion }
  sigversion { lex' TokenSigVersion }
  [Ss]ig[Tt]ype { lex' TokenSigType }
  [Pp][Kk][Aa]lgo { lex' TokenPKAlgo }
  [Ss]ig[Pp][Kk][Aa]lgo { lex' TokenSigPKAlgo }
  [Hh]ash[Aa]lgo { lex' TokenHashAlgo }
  [Rr][Ss][Aa] { lex' TokenRSA }
  [Dd][Ss][Aa] { lex' TokenDSA }
  [Ee]l[Gg]amal { lex' TokenElgamal }
  [Ee][Cc][Dd][Ss][Aa] { lex' TokenECDSA }
  [Ee][Cc][Dd][Hh] { lex' TokenECDH }
  [Dd][Hh] { lex' TokenDH }
  [Bb]inary { lex' TokenBinary }
  [Cc]anonical[Tt]ext { lex' TokenCanonicalText }
  [Ss]tandalone { lex' TokenStandalone }
  [Gg]eneric[Cc]ert { lex' TokenGenericCert }
  [Pp]ersona[Cc]ert { lex' TokenPersonaCert }
  [Cc]asual[Cc]ert { lex' TokenCasualCert }
  [Pp]ositive[Cc]ert { lex' TokenPositiveCert }
  [Ss]ubkey[Bb]inding[Ss]ig { lex' TokenSubkeyBindingSig }
  [Pp]rimary[Kk]ey[Bb]inding[Ss]ig { lex' TokenPrimaryKeyBindingSig }
  [Ss]ignature[Dd]irectly[Oo]n[Aa][Kk]ey { lex' TokenSignatureDirectlyOnAKey }
  [Kk]ey[Rr]evocation[Ss]ig { lex' TokenKeyRevocationSig }
  [Ss]ubkey[Rr]evocation[Ss]ig { lex' TokenSubkeyRevocationSig }
  [Cc]ert[Rr]evocation[Ss]ig { lex' TokenCertRevocationSig }
  [Tt]imestamp[Ss]ig { lex' TokenTimestampSig }
  [Mm][Dd]5 { lex' TokenMD5 }
  [Ss][Hh][Aa]1 { lex' TokenSHA1 }
  [Rr][Ii][Pp][Ee][Mm][Dd]160 { lex' TokenRIPEMD160 }
  [Ss][Hh][Aa]256 { lex' TokenSHA256 }
  [Ss][Hh][Aa]384 { lex' TokenSHA384 }
  [Ss][Hh][Aa]512 { lex' TokenSHA512 }
  [Ss][Hh][Aa]224 { lex' TokenSHA224 }
  [Uu][Ii][Dd]s { lex' TokenUids }
  keysize { lex' TokenKeysize }
  length { lex' TokenLength }
  timestamp { lex' TokenTimestamp }
  fingerprint { lex' TokenFingerprint }
  keyid { lex' TokenKeyID }
  $hexdigit{9}$hexdigit{9}$hexdigit{9}$hexdigit{9}$hexdigit{4} { lex (TokenFpr . read) }
  0x$hexdigit{9}$hexdigit{9}$hexdigit{9}$hexdigit{9}$hexdigit{4} { lex (TokenFpr . read . drop 2) }
  $hexdigit{8}$hexdigit{8} { lex (TokenLongID . Right . read) }
  0x$hexdigit{8}$hexdigit{8} { lex (TokenLongID . Right . read . drop 2) }
  $digit+ { lex (TokenInt  . fromIntegral . read) }
  $hexdigit+ { lex (TokenInt  . fromIntegral . fst . head . readHex) }
  0x$hexdigit+ { lex (TokenInt  . fromIntegral . fst . head . readHex . drop 2) }
  \".*\" { lex (TokenStr . reverse . drop 1 . reverse . drop 1) }

{
data Token
  = TokenTag
  | TokenAnd
  | TokenAny
  | TokenNot
  | TokenOr
  | TokenInt Integer
  | TokenEq
  | TokenLt
  | TokenGt
  | TokenLParen
  | TokenRParen
  | TokenEOF
  | TokenPKVersion
  | TokenSigVersion
  | TokenSigType
  | TokenPKAlgo
  | TokenSigPKAlgo
  | TokenHashAlgo
  | TokenRSA
  | TokenDSA
  | TokenElgamal
  | TokenECDSA
  | TokenECDH
  | TokenDH
  | TokenBinary
  | TokenCanonicalText
  | TokenStandalone
  | TokenGenericCert
  | TokenPersonaCert
  | TokenCasualCert
  | TokenPositiveCert
  | TokenSubkeyBindingSig
  | TokenPrimaryKeyBindingSig
  | TokenSignatureDirectlyOnAKey
  | TokenKeyRevocationSig
  | TokenSubkeyRevocationSig
  | TokenCertRevocationSig
  | TokenTimestampSig
  | TokenMD5
  | TokenSHA1
  | TokenRIPEMD160
  | TokenSHA256
  | TokenSHA384
  | TokenSHA512
  | TokenSHA224
  | TokenKeysize
  | TokenTimestamp
  | TokenFingerprint
  | TokenKeyID
  | TokenFpr TwentyOctetFingerprint
  | TokenLongID (Either String EightOctetKeyId)
  | TokenLength
  | TokenEvery
  | TokenOne
  | TokenOf
  | TokenContains
  | TokenUids
  | TokenStr String
  | TokenA
  | TokenSubkey
  deriving (Eq,Show)

alexEOF = return TokenEOF

lex :: (String -> a) -> AlexAction a
lex f = \(_,_,_,s) i -> return (f (take i s))

lex' :: a -> AlexAction a
lex' = lex . const

}