{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 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.Util ((*<|>), (?:), tryMany, patternMatcher, sourcePosition, number, variable, boolean, scadString, scadUndefined) where

import Prelude (String, Char, ($), foldl1, fmap, (.), pure, (*>), Bool(True, False), read, (**), (*), (==), (<>), (<$>), (<$))

import Text.Parsec (SourcePos, (<|>), (<?>), try, char, sepBy, noneOf, string, many, digit, many1, optional, choice, option, oneOf, between)

import Text.Parsec.String (GenParser)

import qualified Text.Parsec as P (sourceLine, sourceColumn, sourceName)

import Text.Parsec.Prim (ParsecT)

import Data.Functor.Identity (Identity)

import Graphics.Implicit.ExtOpenScad.Definitions (Pattern(Wild, Name, ListP), SourcePosition(SourcePosition), Symbol(Symbol), Expr(LitE, Var), OVal(ONum, OString, OBool, OUndefined))

import Graphics.Implicit.Definitions (toFastℕ)

-- The lexer.
import Graphics.Implicit.ExtOpenScad.Parser.Lexer (matchIdentifier, matchTok, matchUndef, matchTrue, matchFalse, whiteSpace, surroundedBy, matchComma)

import Data.Functor (($>))

import Data.Text.Lazy (pack)

infixr 1 *<|>
(*<|>) :: GenParser tok u a -> ParsecT [tok] u Identity a -> ParsecT [tok] u Identity a
GenParser tok u a
a *<|> :: forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> GenParser tok u a
b = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try GenParser tok u a
a forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser tok u a
b

infixr 2 ?:
(?:) :: String -> ParsecT s u m a -> ParsecT s u m a
String
l ?: :: forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?: ParsecT s u m a
p = ParsecT s u m a
p forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
l

tryMany :: [GenParser tok u a] -> ParsecT [tok] u Identity a
tryMany :: forall tok u a. [GenParser tok u a] -> GenParser tok u a
tryMany = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try

-- | A pattern parser
patternMatcher :: GenParser Char st Pattern
patternMatcher :: forall st. GenParser Char st Pattern
patternMatcher = String
"pattern" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?:
          (Pattern
Wild forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( Symbol -> Pattern
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Symbol
Symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st String
matchIdentifier)
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( [Pattern] -> Pattern
ListP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'[' (forall st. GenParser Char st Pattern
patternMatcher forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` forall st. GenParser Char st Text
matchComma) Char
']' )

-- expression parsers

-- | Parse a number.
number :: GenParser Char st Expr
number :: forall st. GenParser Char st Expr
number = (String
"number" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?:) forall a b. (a -> b) -> a -> b
$ do
  String
h <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
       [
         do
           String
a <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
           String
b <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ( (Char
'.'forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) )
           forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
a forall a. Semigroup a => a -> a -> a
<> String
b)
        ,
        (String
"0." forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
        ]
  String
d <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"0"
       (
         forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"eE" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
         [
           (Char
'-'forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
         ,
           forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
         ]
       )
  ()
_ <- forall st. GenParser Char st ()
whiteSpace
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. OVal -> Expr
LitE forall a b. (a -> b) -> a -> b
$ ℝ -> OVal
ONum forall a b. (a -> b) -> a -> b
$ if String
d forall a. Eq a => a -> a -> Bool
== String
"0"
                         then forall a. Read a => String -> a
read String
h
                         else forall a. Read a => String -> a
read String
h forall a. Num a => a -> a -> a
* (ℝ
10 forall a. Floating a => a -> a -> a
** forall a. Read a => String -> a
read String
d)

-- | Parse a variable reference.
--   NOTE: abused by the parser for function calls.
variable :: GenParser Char st Expr
variable :: forall st. GenParser Char st Expr
variable = String
"variable" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?:
  Symbol -> Expr
Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Symbol
Symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st. GenParser Char st String
matchIdentifier

-- | Parse a true or false value.
boolean :: GenParser Char st Expr
boolean :: forall st. GenParser Char st Expr
boolean = String
"boolean" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?:
  OVal -> Expr
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> OVal
OBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall st. GenParser Char st ()
matchTrue forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall st. GenParser Char st ()
matchFalse forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)

-- | Parse a quoted string.
--   FIXME: no @\u@ unicode support?
scadString :: GenParser Char st Expr
scadString :: forall st. GenParser Char st Expr
scadString = String
"string" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?: OVal -> Expr
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OVal
OString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')
      (forall st. Char -> GenParser Char st Char
matchTok Char
'"')
      (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$
        (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\"" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\"') forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
        (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\n"  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n') forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
        (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\r"  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r') forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
        (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\t"  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t') forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
        (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\\') forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
        forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"\n"
      )

scadUndefined :: GenParser Char st Expr
scadUndefined :: forall st. GenParser Char st Expr
scadUndefined = String
"undefined" forall s u (m :: * -> *) a.
String -> ParsecT s u m a -> ParsecT s u m a
?:
  OVal -> Expr
LitE OVal
OUndefined forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall st. GenParser Char st ()
matchUndef

sourcePosition :: SourcePos -> SourcePosition
sourcePosition :: SourcePos -> SourcePosition
sourcePosition SourcePos
pos = Fastℕ -> Fastℕ -> String -> SourcePosition
SourcePosition (forall n. FastN n => n -> Fastℕ
toFastℕ forall a b. (a -> b) -> a -> b
$ SourcePos -> Line
P.sourceLine SourcePos
pos) (forall n. FastN n => n -> Fastℕ
toFastℕ forall a b. (a -> b) -> a -> b
$ SourcePos -> Line
P.sourceColumn SourcePos
pos) (SourcePos -> String
P.sourceName SourcePos
pos)