{-|
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(..),

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

    -- * Float literals
    mkFloat,

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

import Data.Char (digitToInt)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Numeric (readInt, readHex, readOct)

-- | Lexical token
data Token
    = TokTrue                       -- ^ @true@
    | TokFalse                      -- ^ @false@
    | TokComma                      -- ^ @','@
    | TokEquals                     -- ^ @'='@
    | TokNewline                    -- ^ @end-of-line@
    | 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
    | TokEOF                        -- ^ @end-of-input@
    deriving (ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
(Int -> ReadS Token)
-> ReadS [Token]
-> ReadPrec Token
-> ReadPrec [Token]
-> Read Token
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Token
readsPrec :: Int -> ReadS Token
$creadList :: ReadS [Token]
readList :: ReadS [Token]
$creadPrec :: ReadPrec Token
readPrec :: ReadPrec Token
$creadListPrec :: ReadPrec [Token]
readListPrec :: ReadPrec [Token]
Read, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)

-- | Remove underscores from number literals
scrub :: String -> String
scrub :: ShowS
scrub = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'_' Char -> Char -> Bool
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 (String -> Integer
forall a. Read a => String -> a
read (ShowS
scrub String
xs))
mkDecInteger String
xs = Integer -> Token
TokInteger (String -> Integer
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 ((Integer, String) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, String)] -> (Integer, String)
forall a. HasCallStack => [a] -> a
head (ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex (ShowS
scrub String
xs))))
mkHexInteger String
_ = String -> Token
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 ((Integer, String) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, String)] -> (Integer, String)
forall a. HasCallStack => [a] -> a
head (ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readOct (ShowS
scrub String
xs))))
mkOctInteger String
_ = String -> Token
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 ((Integer, String) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, String)] -> (Integer, String)
forall a. HasCallStack => [a] -> a
head (ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readBin (ShowS
scrub String
xs))))
mkBinInteger String
_ = String -> Token
forall a. HasCallStack => String -> a
error String
"processHex: bad input"

-- This wasn't added to base until 4.16
readBin :: (Eq a, Num a) => ReadS a
readBin :: forall a. (Eq a, Num a) => ReadS a
readBin = a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt a
2 Char -> Bool
isBinDigit Char -> Int
digitToInt

isBinDigit :: Char -> Bool
isBinDigit :: Char -> Bool
isBinDigit Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1'

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