JsonnetLexer.hs

module Parse where

import Control.Monad (void)
import qualified Data.Char
import Text.Megaparsec
import Text.Megaparsec.String
import qualified Text.Megaparsec.Lexer as L

data JsonnetNumber = JInt   Integer
                   | JFloat Double

instance Show JsonnetNumber where
    show (JInt n)   = show n
    show (JFloat n) = show n

data JsonnetString = SingleQuoteString         String
                   | DoubleQuoteString         String
                   | TripleQuoteString         String
                   | SingleQuoteVerbatimString String
                   | DoubleQuoteVerbatimString String

instance Show JsonnetString where
    show (SingleQuoteString x) = "'" ++ x ++ "'" -- FIXME escape '
    show (DoubleQuoteString x) = show x
    show (TripleQuoteString x) = "|||\n" ++ x ++ "\n|||" -- FIXME indentation
    show (SingleQuoteVerbatimString x) = show x  -- FIXME
    show (DoubleQuoteVerbatimString x) = show x  -- FIXME

data TokenStream = TokenStream [JsonnetToken]

instance Show TokenStream where
    show (TokenStream x) = concatMap show x

data JsonnetToken = Id String
                  | Number JsonnetNumber
                  | String JsonnetString
                  | Symbol Char
                  | Operator String
                  | ReservedWord String

instance Show JsonnetToken where
    show (Id x) = x
    show (Number n) = show n
    show (String s) = show s
    show (Symbol ';') = "; "
    show (Symbol ',') = ", "
    show (Symbol '{') = "{ "
    show (Symbol c) = [c]
    show (Operator ":") = ": "
    show (Operator "=") = " = "
    show (Operator "%") = " % "
    show (Operator o) = o
    show (ReservedWord r) = r ++ " "

jsonnetToken :: Parser JsonnetToken
jsonnetToken =
    choice [ jsonnetIdentifier
           , jsonnetNumber
           , jsonnetString
           , jsonnetSymbol
           , jsonnetOperator
           , jsonnetReservedWord
           ]

sc :: Parser ()
sc = L.space (void spaceChar) lineComment blockComment where
  lineComment = L.skipLineComment "//" <|> L.skipLineComment "#"
  blockComment = L.skipBlockComment "/*" "*/"

lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc

symbol :: String -> Parser String
symbol = L.symbol sc

jsonnetSymbol :: Parser JsonnetToken
jsonnetSymbol = Symbol <$> lexeme (oneOf "{}[],.();")

jsonnetOperator :: Parser JsonnetToken
jsonnetOperator = Operator <$> (lexeme . try) (oneCharOp <|> multiCharOp)

oneCharOp :: Parser String
oneCharOp = count 1 (opChar1 <* notFollowedBy opChar1) where
  opChar1 = oneOf ("$:&|^=<>*/%" ++ "+-~!")

multiCharOp :: Parser String
multiCharOp = some operatorChar where
  operatorChar = choice [ try (char '/' <* notFollowedBy (oneOf "/*"))
                        , try (char '|' <* notFollowedBy (symbol "||"))
                        , oneOf "$:&^=<>*%"
                        , oneOf "+-~!" <* lookAhead operatorChar
                        ]

jsonnetNumber = try jsonnetFloat <|> jsonnetInteger

jsonnetInteger :: Parser JsonnetToken
jsonnetInteger = (Number . JInt) <$> lexeme L.integer

jsonnetFloat :: Parser JsonnetToken
jsonnetFloat = (Number . JFloat) <$> lexeme L.float

rword :: String -> Parser String
rword w = string w <* notFollowedBy alphaNumChar <* sc

reservedWords = ["assert", "else", "error", "false", "for",
                 "function", "if", "import", "importstr", "in",
                 "local", "null", "tailstrict", "then", "self",
                 "super", "true"]

jsonnetReservedWord :: Parser JsonnetToken
jsonnetReservedWord = ReservedWord <$> choice (map rword reservedWords)

jsonnetIdentifier :: Parser JsonnetToken
jsonnetIdentifier = (lexeme . try) (p >>= check) where
  p = (:) <$> letterChar <*> many alphaNumChar
  check x = if x `elem` reservedWords
              then fail $ "keyword " ++ show x ++ " cannot be an identifier"
              else return (Id x)

jsonnetString :: Parser JsonnetToken
jsonnetString = String <$> lexeme (choice [ doubleQuoteString
                                          , singleQuoteString
                                          --, tripleQuoteString         -- FIXME
                                          --, singleQuoteVerbatimString -- FIXME
                                          --, doubleQuoteVerbatimString -- FIXME
                                          ])

doubleQuoteString :: Parser JsonnetString
doubleQuoteString =
    DoubleQuoteString <$>
      between (char '"') (char '"')
              (some (escapedChar <|> noneOf "\""))

singleQuoteString :: Parser JsonnetString
singleQuoteString =
    SingleQuoteString <$>
      between (char '\'') (char '\'')
              (some (escapedChar <|> noneOf "\'"))

escapedChar :: Parser Char
escapedChar = do
    char '\\'
    x <- oneOf "\"'\\bfnrt0u"
    case x of
      '"'  -> return '"'
      '\'' -> return '\''
      '\\' -> return '\\'
      '/'  -> return '/'
      'b'  -> return '\b'
      'f'  -> return '\f'
      'n'  -> return '\n'
      'r'  -> return '\r'
      't'  -> return '\t'
      -- this \0nnn stuff is mentioned in the spec, but is it implemented in
      -- the C++ jsonnet code?
      '0'  -> do
        d <- count' 1 3 octDigitChar
        (return . Data.Char.chr . read) ("0o" ++ d)
      'u'  -> do
        d <- count 4 hexDigitChar
        (return . Data.Char.chr . read) ("0x" ++ d)

lexJsonnet :: Parser TokenStream
lexJsonnet = TokenStream <$> (sc *> many jsonnetToken)