content: {- Copyright 2013-2022 NGLess Authors
   - License: MIT
   -}
  {-# LANGUAGE FlexibleContexts, CPP #-}
  
  -- | This module handles tokenization
  module Tokens
      ( Token(..)
      , tokenize
  #ifdef IS_BUILDING_TEST
      , eol
  #endif
      ) where
  
  import qualified Data.Text as T
  import Control.Monad (void)
  import Text.Parsec.Text ()
  import Text.Parsec.Combinator
  import Data.Functor (($>))
  import Text.Parsec
  
  import NGLess.NGError
  import Language
  
  -- | Token datatype
  data Token =
          TExpr Expression -- ^ These are Const* type of expressions
          | TBop BOp -- ^ Binary operators
          | TReserved T.Text -- ^ Reserved keywords
          | TConstant T.Text -- ^ Builtin constant
          | TWord T.Text -- ^ Any other word (function name, variable, &c)
          | TOperator Char -- ^ A single character operator (',', '[', ...)
          | TNewLine -- ^ A new line
          | TIndent Int -- ^ A sequence of spaces
      deriving (Eq, Show)
  
  -- | tokenize is the main function of this module
  -- It returns tokens with position information (the position in the original
  -- file)
  tokenize :: String -- ^ input filename (for error messages)
          -> T.Text -- ^ input text
          -> NGLess [(SourcePos,Token)]
  tokenize inname input = case parse tokenizer inname input of
          Right val -> return val
          Left err -> throwScriptError $ show err
  
  tokenizer = many ngltoken' <* eof
  ngltoken' = (,) <$> getPosition <*> ngltoken
  
  -- | 'ngltoken' parse a token as a series of possibilities.
  -- All of these are written so that they never fail after consuming input
  ngltoken = comment
          <|> symbol
          <|> tstring
          <|> double
          <|> integer
          <|> word
          <|> boperator
          <|> operator
          <|> indent
          <|> taberror
          <|> eol
  
  eol = semicolon <|> real_eol
      where
          real_eol = ((char '\r' *> char '\n') <|> char '\n') $> TNewLine
          semicolon = char ';' *> skipMany (char ' ') $> TNewLine
  
  try_string s = try (string s)
  
  symbol = char '{'  *>
                  (TExpr . ConstSymbol . T.pack <$> many1 (char '_' <|> alphaNum))
                  <* (option () $ char '-' *> parserFail "Symbols cannot contain hyphens (-), perhaps you meant to use an underscore.")
                  <* char '}'
  
  tstring = tstring' '\'' <|> tstring' '"'
      where tstring' term = char term *> (TExpr . ConstStr <$> strtext term) <* char term
  strtext term = T.pack <$> many (escapedchar <|> noneOf [term])
      where
          escapedchar = char '\\' *> escapedchar'
          escapedchar' = do
              c <- anyChar
              case c of
                  'n' -> return '\n'
                  't' -> return '\t'
                  '\\' -> return '\\'
                  _ -> return c
  comment = singlelinecomment <|> multilinecomment
  singlelinecomment = commentstart *> skiptoeol
      where commentstart = (void $ char '#') <|> (void . try $ string "//")
  skiptoeol = eol  <|> (anyChar *> skiptoeol)
  multilinecomment = try_string "/*" *> skipmultilinecomment
  skipmultilinecomment = (try_string "*/" $> TIndent 0)
              <|> (anyChar *> skipmultilinecomment)
              <|> (eof *> fail "Unexpected End Of File inside a comment")
  
  word = try $ do
      k <- variableStr
      let k' = pure (T.pack k)
      case k of
          "true" -> pure (TExpr $ ConstBool True)
          "True" -> pure (TExpr $ ConstBool True)
          "false" -> pure (TExpr $ ConstBool False)
          "False" -> pure (TExpr $ ConstBool False)
          _
              | k `elem` reservedwords -> TReserved <$> k'
              | k `elem` constants -> TExpr . BuiltinConstant . Variable <$> k'
              | otherwise -> TWord <$> k'
  
  reservedwords =
          ["if"
          ,"else"
          ,"ngless"
          ,"len"
          ,"discard"
          ,"continue"
          ,"not"
          ,"local"
          ,"import"
          ,"using"
          ]
  
  constants =
          ["STDIN"
          ,"STDOUT"
          ]
  
  variableStrSimple = (:) <$> (char '_' <|> letter) <*> many (char '_' <|> alphaNum)
  -- variableStr is `variableStrSimple` or `variableStrSimple`::`variableStrSimple`
  variableStr = do
      s <- variableStrSimple
      let long = try $ do
              _ <- string "::"
              s' <- variableStrSimple
              return $ concat [s, "::", s']
      long <|> return s
  
  operator = TOperator <$> oneOf "=,+-*():[]<>.|"
  boperator =
          -- Check for a not-so-unreasonable user mistake
          (try_string "<\\>" *> fail "<\\> found. Did you mean </>?")
          <|> choice [
                  (try_string long $> TBop short)
                      | (long,short) <-
                      [ ("!=", BOpNEQ)
                      , ("==", BOpEQ)
  
                      , ("</>", BOpPathAppend)
  
                      , ("<=", BOpLTE)
                      , ("<", BOpLT)
                      , (">=", BOpGTE)
                      , (">", BOpGT)
  
                      , ("+", BOpAdd)
                      , ("*", BOpMul)
                      ]]
  indent = TIndent . length <$> many1 (char ' ')
  taberror = tab *> fail "Tabs are not used in NGLess. Please use spaces."
  
  double = TExpr . ConstDouble . read <$> try double'
      where
          double' = (\int frac -> (int ++ "." ++ frac)) <$> many1 digit <*> (char '.' *> many1 digit)
  
  integer = TExpr . ConstInt <$> (try hex <|> dec)
      where
          hex = read . ("0x"++) <$> (string "0x" *> many1 hexDigit)
          dec = read <$> many1 digit
  