{- 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 :: forall u0. GenLanguageDef String u0 Identity
openScadStyle
    = forall u0. GenLanguageDef String u0 Identity
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 =  forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> 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 = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> 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 :: forall st. GenTokenParser String st Identity
lexer = forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
makeTokenParser forall u0. GenLanguageDef String u0 Identity
openScadStyle

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

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

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

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

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

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

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

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

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

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

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

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

-- | match a single character token followed by whitespace.
matchTok :: Char -> GenParser Char st Char
matchTok :: forall st. Char -> GenParser Char st Char
matchTok Char
x = do
  Char
y <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
x
  ()
_ <- forall st. GenParser Char st ()
whiteSpace
  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 :: forall st. GenParser Char st Text
matchColon = forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
colon forall st. GenTokenParser String st Identity
lexer forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
":"

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

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

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