module Toml.Lexer.Token (
Token(..),
mkLiteralString,
mkMlLiteralString,
mkBinInteger,
mkDecInteger,
mkOctInteger,
mkHexInteger,
mkFloat,
localDatePatterns,
localTimePatterns,
localDateTimePatterns,
offsetDateTimePatterns,
mkError,
) where
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Numeric (readBin, readHex, readOct)
data Token
= TokTrue
| TokFalse
| TokComma
| TokEquals
| TokNewline
| TokPeriod
| TokSquareO
| TokSquareC
| Tok2SquareO
| Tok2SquareC
| TokCurlyO
| TokCurlyC
| TokBareKey String
| TokString String
| TokMlString String
| TokInteger !Integer
| TokFloat !Double
| TokOffsetDateTime !ZonedTime
| TokLocalDateTime !LocalTime
| TokLocalDate !Day
| TokLocalTime !TimeOfDay
| TokError String
| TokEOF
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)
scrub :: String -> String
scrub :: ShowS
scrub = forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'_' forall a. Eq a => a -> a -> Bool
/=)
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))
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"
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"
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"
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))
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
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"
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)
localDatePatterns :: [String]
localDatePatterns :: [String]
localDatePatterns = [String
"%Y-%m-%d"]
localTimePatterns :: [String]
localTimePatterns :: [String]
localTimePatterns = [String
"%H:%M:%S%Q"]
localDateTimePatterns :: [String]
localDateTimePatterns :: [String]
localDateTimePatterns =
[String
"%Y-%m-%dT%H:%M:%S%Q",
String
"%Y-%m-%d %H:%M:%S%Q"]
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"]