{-|
Module      : Toml.Lexer.Token
Description : Lexical tokens
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the datatype for the lexical syntax of TOML files.
These tokens are generated by "Toml.Lexer" and consumed in "Toml.Parser".

-}
module Toml.Lexer.Token (
    -- * Types
    Token(..),

    -- * String literals
    mkLiteralString,
    mkMlLiteralString,

    -- * Integer literals
    mkBinInteger,
    mkDecInteger,
    mkOctInteger,
    mkHexInteger,

    -- * Float literals
    mkFloat,

    -- * Date and time patterns
    localDatePatterns,
    localTimePatterns,
    localDateTimePatterns,
    offsetDateTimePatterns,

    -- * Errors
    mkError,
    ) where

import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Numeric (readBin, readHex, readOct)

-- | Lexical token
data Token
    = TokTrue                       -- ^ @true@
    | TokFalse                      -- ^ @false@
    | TokComma                      -- ^ @','@
    | TokEquals                     -- ^ @'='@
    | TokNewline                    -- ^ @'\\n'@
    | TokPeriod                     -- ^ @'.'@
    | TokSquareO                    -- ^ @'['@
    | TokSquareC                    -- ^ @']'@
    | Tok2SquareO                   -- ^ @'[['@
    | Tok2SquareC                   -- ^ @']]'@
    | TokCurlyO                     -- ^ @'{'@
    | TokCurlyC                     -- ^ @'}'@
    | TokBareKey String             -- ^ bare key
    | TokString String              -- ^ string literal
    | TokMlString String            -- ^ multiline string literal
    | TokInteger !Integer           -- ^ integer literal
    | TokFloat !Double              -- ^ floating-point literal
    | TokOffsetDateTime !ZonedTime  -- ^ date-time with timezone offset
    | TokLocalDateTime !LocalTime   -- ^ local date-time
    | TokLocalDate !Day             -- ^ local date
    | TokLocalTime !TimeOfDay       -- ^ local time
    | TokError String               -- ^ lexical error
    | TokEOF                        -- ^ end of file
    deriving (ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS Token
Read, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

-- | Remove underscores from number literals
scrub :: String -> String
scrub :: ShowS
scrub = forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'_' forall a. Eq a => a -> a -> Bool
/=)

-- | Construct a 'TokInteger' from a decimal integer literal lexeme.
mkDecInteger :: String -> Token
mkDecInteger :: String -> Token
mkDecInteger (Char
'+':String
xs) = Integer -> Token
TokInteger (forall a. Read a => String -> a
read (ShowS
scrub String
xs))
mkDecInteger String
xs = Integer -> Token
TokInteger (forall a. Read a => String -> a
read (ShowS
scrub String
xs))

-- | Construct a 'TokInteger' from a hexadecimal integer literal lexeme.
mkHexInteger :: String -> Token
mkHexInteger :: String -> Token
mkHexInteger (Char
'0':Char
'x':String
xs) = Integer -> Token
TokInteger (forall a b. (a, b) -> a
fst (forall a. [a] -> a
head (forall a. (Eq a, Num a) => ReadS a
readHex (ShowS
scrub String
xs))))
mkHexInteger String
_ = forall a. HasCallStack => String -> a
error String
"processHex: bad input"

-- | Construct a 'TokInteger' from a octal integer literal lexeme.
mkOctInteger :: String -> Token
mkOctInteger :: String -> Token
mkOctInteger (Char
'0':Char
'o':String
xs) = Integer -> Token
TokInteger (forall a b. (a, b) -> a
fst (forall a. [a] -> a
head (forall a. (Eq a, Num a) => ReadS a
readOct (ShowS
scrub String
xs))))
mkOctInteger String
_ = forall a. HasCallStack => String -> a
error String
"processHex: bad input"

-- | Construct a 'TokInteger' from a binary integer literal lexeme.
mkBinInteger :: String -> Token
mkBinInteger :: String -> Token
mkBinInteger (Char
'0':Char
'b':String
xs) = Integer -> Token
TokInteger (forall a b. (a, b) -> a
fst (forall a. [a] -> a
head (forall a. (Eq a, Num a) => ReadS a
readBin (ShowS
scrub String
xs))))
mkBinInteger String
_ = forall a. HasCallStack => String -> a
error String
"processHex: bad input"

-- | Construct a 'TokFloat' from a floating-point literal lexeme.
mkFloat :: String -> Token
mkFloat :: String -> Token
mkFloat String
"nan"   = Double -> Token
TokFloat (Double
0forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat String
"+nan"  = Double -> Token
TokFloat (Double
0forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat String
"-nan"  = Double -> Token
TokFloat (Double
0forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat String
"inf"   = Double -> Token
TokFloat (Double
1forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat String
"+inf"  = Double -> Token
TokFloat (Double
1forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat String
"-inf"  = Double -> Token
TokFloat (-Double
1forall a. Fractional a => a -> a -> a
/Double
0)
mkFloat (Char
'+':String
x) = Double -> Token
TokFloat (forall a. Read a => String -> a
read (ShowS
scrub String
x))
mkFloat String
x       = Double -> Token
TokFloat (forall a. Read a => String -> a
read (ShowS
scrub String
x))

-- | Construct a 'TokString' from a literal string lexeme.
mkLiteralString :: String -> Token
mkLiteralString :: String -> Token
mkLiteralString = String -> Token
TokString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init

-- | Construct a 'TokMlString' from a literal multi-line string lexeme.
mkMlLiteralString :: String -> Token
mkMlLiteralString :: String -> Token
mkMlLiteralString String
str =
    String -> Token
TokMlString
    case String
str of
        Char
'\'':Char
'\'':Char
'\'':Char
'\r':Char
'\n':String
start -> ShowS
go String
start
        Char
'\'':Char
'\'':Char
'\'':Char
'\n':String
start -> ShowS
go String
start
        Char
'\'':Char
'\'':Char
'\'':String
start -> ShowS
go String
start
        String
_ -> forall a. HasCallStack => String -> a
error String
"processMlLiteral: mising initializer"
    where
        go :: ShowS
go String
"'''" = String
""
        go (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: ShowS
go String
xs
        go String
"" = forall a. HasCallStack => String -> a
error String
"processMlLiteral: missing terminator"

-- | Make a 'TokError' from a lexical error message.
mkError :: String -> Token
mkError :: String -> Token
mkError String
""    = String -> Token
TokError String
"unexpected end-of-input"
mkError (Char
x:String
_) = String -> Token
TokError (String
"unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
x)

-- | Format strings for local date lexemes.
localDatePatterns :: [String]
localDatePatterns :: [String]
localDatePatterns = [String
"%Y-%m-%d"]

-- | Format strings for local time lexemes.
localTimePatterns :: [String]
localTimePatterns :: [String]
localTimePatterns = [String
"%H:%M:%S%Q"]

-- | Format strings for local datetime lexemes.
localDateTimePatterns :: [String]
localDateTimePatterns :: [String]
localDateTimePatterns =
    [String
"%Y-%m-%dT%H:%M:%S%Q",
    String
"%Y-%m-%d %H:%M:%S%Q"]

-- | Format strings for offset datetime lexemes.
offsetDateTimePatterns :: [String]
offsetDateTimePatterns :: [String]
offsetDateTimePatterns =
    [String
"%Y-%m-%dT%H:%M:%S%Q%Ez",String
"%Y-%m-%dT%H:%M:%S%QZ",
    String
"%Y-%m-%d %H:%M:%S%Q%Ez",String
"%Y-%m-%d %H:%M:%S%QZ"]