{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-}

module Graphics.Implicit.ExtOpenScad.Parser.Lexer (whiteSpace, matchTrue, matchFalse, matchFunction, matchInclude, matchUse, matchIf, matchElse, matchModule, matchLet, matchUndef, matchTok, matchColon, matchSemi, matchComma, matchIdentifier, surroundedBy, matchLT, matchLE, matchGT, matchGE, matchEQ, matchNE, matchCAT, matchOR, matchAND, matchEXP, matchEach, lexer) where

import Prelude (String, Char, Bool(True), (>>), pure, not, (&&), ($))

import Data.List (notElem)

import Data.Char (isSpace)

import Data.Functor.Identity (Identity)

import Text.Parsec.String (GenParser)

import qualified Text.Parsec.Token as P (whiteSpace, reserved, identifier, reservedOp)

import Text.Parsec.Language (GenLanguageDef, emptyDef)

import Text.Parsec.Token (GenTokenParser, makeTokenParser, commentStart, commentEnd, commentLine, nestedComments, caseSensitive, colon, semi, comma, identStart, identLetter, reservedNames, reservedOpNames)

import Text.Parsec (char, between)

import Text.Parsec.Char (satisfy)

import Data.Text.Lazy (Text)

-- The definition of openscad used by parsec.
openScadStyle :: GenLanguageDef String u0 Identity
openScadStyle :: GenLanguageDef String u0 Identity
openScadStyle
    = GenLanguageDef String u0 Identity
forall st. LanguageDef st
emptyDef
    { commentStart :: String
commentStart = String
"/*"
    , commentEnd :: String
commentEnd = String
"*/"
    , commentLine :: String
commentLine = String
"//"
    , nestedComments :: Bool
nestedComments = Bool
True
    , identStart :: ParsecT String u0 Identity Char
identStart =  (Char -> Bool) -> ParsecT String u0 Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String u0 Identity Char)
-> (Char -> Bool) -> ParsecT String u0 Identity Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
c (String
",|[]{}()+-*&^%#@!~`'\"\\/;:.,<>?=1234567890" :: String) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)
    , identLetter :: ParsecT String u0 Identity Char
identLetter = (Char -> Bool) -> ParsecT String u0 Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String u0 Identity Char)
-> (Char -> Bool) -> ParsecT String u0 Identity Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
c (String
",|[]{}()+-*&^%#@!~`'\"\\/;:.,<>?=" :: String) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)
    , reservedNames :: [String]
reservedNames = [String
"module", String
"function", String
"if", String
"else", String
"let", String
"each", String
"true", String
"false", String
"undef", String
"include", String
"use"]
    , reservedOpNames :: [String]
reservedOpNames= [String
"<=", String
">=", String
"==", String
"!=", String
"&&", String
"||", String
"++", String
"^", String
"<", String
">"]
    , caseSensitive :: Bool
caseSensitive = Bool
True
    }

lexer :: GenTokenParser String st Identity
lexer :: GenTokenParser String st Identity
lexer = GenLanguageDef String st Identity
-> GenTokenParser String st Identity
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
makeTokenParser GenLanguageDef String st Identity
forall st. LanguageDef st
openScadStyle

-- | Consume whitespace.
whiteSpace :: GenParser Char st ()
whiteSpace :: GenParser Char st ()
whiteSpace = GenTokenParser String st Identity -> GenParser Char st ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer

-- | Match the module keyword.
matchModule :: GenParser Char st ()
matchModule :: GenParser Char st ()
matchModule = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"module"

-- | Match the function keyword.
matchFunction :: GenParser Char st ()
matchFunction :: GenParser Char st ()
matchFunction = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"function"

-- | Match the if keyword.
matchIf :: GenParser Char st ()
matchIf :: GenParser Char st ()
matchIf = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"if"

-- | Match the else keyword.
matchElse :: GenParser Char st ()
matchElse :: GenParser Char st ()
matchElse = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"else"

-- | Match the let keyword.
matchLet :: GenParser Char st ()
matchLet :: GenParser Char st ()
matchLet = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"let"

-- | Match the each keyword.
matchEach :: GenParser Char st ()
matchEach :: GenParser Char st ()
matchEach = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"each"

-- | Match boolean true.
matchTrue :: GenParser Char st ()
matchTrue :: GenParser Char st ()
matchTrue = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"true"

-- | Match boolean false
matchFalse :: GenParser Char st ()
matchFalse :: GenParser Char st ()
matchFalse = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"false"

-- | Match the undef keyword.
matchUndef :: GenParser Char st ()
matchUndef :: GenParser Char st ()
matchUndef = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"undef"

-- | Match the include keyword.
matchInclude :: GenParser Char st ()
matchInclude :: GenParser Char st ()
matchInclude = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"include"

-- | Match the use keyword.
matchUse :: GenParser Char st ()
matchUse :: GenParser Char st ()
matchUse = GenTokenParser String st Identity -> String -> GenParser Char st ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"use"

-- | match a single character token followed by whitespace.
matchTok :: Char -> GenParser Char st Char
matchTok :: Char -> GenParser Char st Char
matchTok Char
x = do
  Char
y <- Char -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
x
  ()
_ <- GenParser Char st ()
forall st. GenParser Char st ()
whiteSpace
  Char -> GenParser Char st Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
y
--matchTok tok = lexeme lexer $ symbol lexer [tok]

-- | match a colon.
matchColon :: GenParser Char st Text
matchColon :: GenParser Char st Text
matchColon = GenTokenParser String st Identity
-> ParsecT String st Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
colon GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer ParsecT String st Identity String
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":"

-- | match a semicolon.
matchSemi :: GenParser Char st Text
matchSemi :: GenParser Char st Text
matchSemi = GenTokenParser String st Identity
-> ParsecT String st Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
semi GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer ParsecT String st Identity String
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
";"

-- | match a comma.
matchComma :: GenParser Char st Text
matchComma :: GenParser Char st Text
matchComma = GenTokenParser String st Identity
-> ParsecT String st Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
comma GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer ParsecT String st Identity String
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
","

-- | Match operators.
matchLE :: GenParser Char st Text
matchLE :: GenParser Char st Text
matchLE = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"<=" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<="
matchLT :: GenParser Char st Text
matchLT :: GenParser Char st Text
matchLT = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"<" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<"
matchGE :: GenParser Char st Text
matchGE :: GenParser Char st Text
matchGE = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
">=" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
">="
matchGT :: GenParser Char st Text
matchGT :: GenParser Char st Text
matchGT = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
">" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
">"
matchEQ :: GenParser Char st Text
matchEQ :: GenParser Char st Text
matchEQ = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"==" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"=="
matchNE :: GenParser Char st Text
matchNE :: GenParser Char st Text
matchNE = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"!=" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"!="
matchAND :: GenParser Char st Text
matchAND :: GenParser Char st Text
matchAND = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"&&" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"&&"
matchOR :: GenParser Char st Text
matchOR :: GenParser Char st Text
matchOR = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"||" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"||"
matchCAT :: GenParser Char st Text
matchCAT :: GenParser Char st Text
matchCAT = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"++" ParsecT String st Identity ()
-> GenParser Char st Text -> GenParser Char st Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> GenParser Char st Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"++"
matchEXP :: GenParser Char st Char
matchEXP :: GenParser Char st Char
matchEXP = GenTokenParser String st Identity
-> String -> ParsecT String st Identity ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer String
"^" ParsecT String st Identity ()
-> GenParser Char st Char -> GenParser Char st Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> GenParser Char st Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'^'

-- | match something between two ends.
surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy :: Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
leftTok GenParser Char st a
middle Char
rightTok = ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> GenParser Char st a
-> GenParser Char st a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
leftTok) (Char -> ParsecT String st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
rightTok) GenParser Char st a
middle

-- | match an identifier. variable name, function name, module name, etc.
matchIdentifier :: GenParser Char st String
matchIdentifier :: GenParser Char st String
matchIdentifier = GenTokenParser String st Identity -> GenParser Char st String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier GenTokenParser String st Identity
forall st. GenTokenParser String st Identity
lexer