{-|
Module      : Godot.Parser.Resource
Description : Megaparsec parser for the Godot resource file format.
Copyright   : (c) Winston Hartnett, 2021
License     : GPL-3
Maintainer  : whartnett@gmail.com
Stability   : experimental
Portability : POSIX

A parser for Godot resource file formats. Currently only supports auto-generated
`tscn` and `gdns` files.
-}
{-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE OverloadedStrings #-}

module Godot.Parser.Resource
  (GodotValue(..)
  ,GodotSection(..)
  ,TscnDescriptor(..)
  ,TscnParsed(..)
  ,OtherDescriptor(..)
  ,OtherParsed(..)
  ,GdnsDescriptor(..)
  ,GdnsParsed(..)
  ,GodotParsed(..)
  ,tscnParser
  ,gdnsParser
  ,otherParser
  ,godotParser) where

import           Control.Applicative        ((<|>),liftA2)
import           Control.Monad              (unless)

import           Data.Char                  (isAlphaNum,isDigit,isUpper)
import           Data.Either                (fromRight)
import           Data.Functor               (($>))
import qualified Data.HashMap.Lazy          as M
import qualified Data.HashSet               as S
import           Data.Maybe                 (fromJust)
import qualified Data.Text                  as T
import qualified Data.Text.Read             as T
import           Data.Void

import           GHC.Generics               (Generic)

import           Prelude                    hiding (exponent)

import qualified Text.Megaparsec            as P
import qualified Text.Megaparsec.Char       as P
import qualified Text.Megaparsec.Char.Lexer as P (decimal,signed)

type Parser = P.Parsec Void T.Text

optionalSign :: Parser T.Text
optionalSign :: Parser Text
optionalSign = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"-" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"+"

godotFloatP :: Parser Float
godotFloatP :: Parser Float
godotFloatP = do
  Text
sign <- Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Text
"" Parser Text
optionalSign
  let takeDigits :: ParsecT Void Text Identity (Tokens Text)
takeDigits = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isDigit
  Text
rational <- Parser Text
ParsecT Void Text Identity (Tokens Text)
takeDigits Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"." Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ParsecT Void Text Identity (Tokens Text)
takeDigits
  Text
exponent <- Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Text
"" (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"e" Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Text
"" Parser Text
optionalSign Parser Text -> Parser Text -> Parser Text
forall a. Semigroup a => a -> a -> a
<> Parser Text
ParsecT Void Text Identity (Tokens Text)
takeDigits)
  Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Parser Float) -> (Text -> Float) -> Text -> Parser Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Text) -> Float
forall a b. (a, b) -> a
fst ((Float, Text) -> Float)
-> (Text -> (Float, Text)) -> Text -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Text) -> Either String (Float, Text) -> (Float, Text)
forall b a. b -> Either a b -> b
fromRight (Float, Text)
forall a. HasCallStack => a
undefined (Either String (Float, Text) -> (Float, Text))
-> (Text -> Either String (Float, Text)) -> Text -> (Float, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Float, Text)
forall a. Fractional a => Reader a
T.rational (Text -> Parser Float) -> Text -> Parser Float
forall a b. (a -> b) -> a -> b
$ Text
sign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rational Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exponent

godotIntP :: Parser Int
godotIntP :: Parser Int
godotIntP = ParsecT Void Text Identity () -> Parser Int -> Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
P.signed ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
P.decimal

godotBoolP :: Parser Bool
godotBoolP :: Parser Bool
godotBoolP = (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"true" Parser Text -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"false" Parser Text -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)

stringP :: Parser T.Text
stringP :: Parser Text
stringP = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"' ParsecT Void Text Identity Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') Parser Text -> ParsecT Void Text Identity Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"'

godotStringP :: Parser T.Text
godotStringP :: Parser Text
godotStringP = Parser Text
stringP

godotArrP :: Parser [GodotValue]
godotArrP :: Parser [GodotValue]
godotArrP = do
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'['
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity Char -> Parser [GodotValue]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill (do
                GodotValue
gVal <- ParsecT Void Text Identity GodotValue
godotValueP
                Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
','
                ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
                GodotValue -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure GodotValue
gVal) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']')

godotDictP :: Parser (M.HashMap T.Text GodotValue)
godotDictP :: Parser (HashMap Text GodotValue)
godotDictP = do
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'{'
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  let kvParser :: ParsecT Void Text Identity (Text, GodotValue)
kvParser = (Text -> GodotValue -> (Text, GodotValue))
-> Parser Text
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity (Text, GodotValue)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Parser Text
stringP (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
':' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity GodotValue
godotValueP)
  [(Text, GodotValue)]
kvs <- ParsecT Void Text Identity (Text, GodotValue)
kvParser ParsecT Void Text Identity (Text, GodotValue)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Text, GodotValue)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`P.sepBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
',' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.hspace)
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'}'
  HashMap Text GodotValue -> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text GodotValue -> Parser (HashMap Text GodotValue))
-> ([(Text, GodotValue)] -> HashMap Text GodotValue)
-> [(Text, GodotValue)]
-> Parser (HashMap Text GodotValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, GodotValue)] -> HashMap Text GodotValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, GodotValue)] -> Parser (HashMap Text GodotValue))
-> [(Text, GodotValue)] -> Parser (HashMap Text GodotValue)
forall a b. (a -> b) -> a -> b
$ [(Text, GodotValue)]
kvs

godotConstructorP :: Parser (T.Text, [GodotValue])
godotConstructorP :: Parser (Text, [GodotValue])
godotConstructorP = do
  let isGodotIdent :: Char -> Bool
isGodotIdent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
  Text
constructorName
    <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isGodotIdent -- TODO Causes problems w/ other delimiters
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'('
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  [GodotValue]
constructorArgs <- ParsecT Void Text Identity GodotValue
godotValueP ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity () -> Parser [GodotValue]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`P.sepBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
',' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.hspace)
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
')'
  (Text, [GodotValue]) -> Parser (Text, [GodotValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
constructorName, [GodotValue]
constructorArgs)

godotNullP :: Parser GodotValue
godotNullP :: ParsecT Void Text Identity GodotValue
godotNullP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"null" Parser Text -> GodotValue -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GodotValue
GodotNull

godotValueP :: Parser GodotValue
godotValueP :: ParsecT Void Text Identity GodotValue
godotValueP = do
  Char
nc <- Text -> Char
T.head (Text -> Char)
-> (State Text Void -> Text) -> State Text Void -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Text Void -> Text
forall s e. State s e -> s
P.stateInput (State Text Void -> Char)
-> ParsecT Void Text Identity (State Text Void)
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
P.getParserState
  case Char
nc of
    Char
'"' -> Text -> GodotValue
GodotString (Text -> GodotValue)
-> Parser Text -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
godotStringP
    Char
'[' -> [GodotValue] -> GodotValue
GodotArr ([GodotValue] -> GodotValue)
-> Parser [GodotValue] -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [GodotValue]
godotArrP
    Char
'{' -> HashMap Text GodotValue -> GodotValue
GodotDict (HashMap Text GodotValue -> GodotValue)
-> Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (HashMap Text GodotValue)
godotDictP
    Char
't' -> Bool -> GodotValue
GodotBool (Bool -> GodotValue)
-> Parser Bool -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
godotBoolP
    Char
'f' -> Bool -> GodotValue
GodotBool (Bool -> GodotValue)
-> Parser Bool -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
godotBoolP
    Char
'n' -> ParsecT Void Text Identity GodotValue
godotNullP
    Char
l
      | Char -> Bool
isUpper Char
l Bool -> Bool -> Bool
|| Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' -> (Text, [GodotValue]) -> GodotValue
GodotConstructor ((Text, [GodotValue]) -> GodotValue)
-> Parser (Text, [GodotValue])
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, [GodotValue])
godotConstructorP
    Char
_   -> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Float -> GodotValue
GodotFloat (Float -> GodotValue)
-> Parser Float -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Float
godotFloatP) ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Int -> GodotValue
GodotInt (Int -> GodotValue)
-> Parser Int -> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
godotIntP)

-- | Values parsed from a Tscn file.
--
-- Constructors are `(constructor name, constructor args)`.
data GodotValue
  = GodotConstructor (T.Text, [GodotValue])
  | GodotInt Int
  | GodotFloat Float
  | GodotBool Bool
  | GodotString T.Text
  | GodotDict (M.HashMap T.Text GodotValue)
  | GodotArr [GodotValue]
  | GodotNull
  deriving (Int -> GodotValue -> ShowS
[GodotValue] -> ShowS
GodotValue -> String
(Int -> GodotValue -> ShowS)
-> (GodotValue -> String)
-> ([GodotValue] -> ShowS)
-> Show GodotValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GodotValue] -> ShowS
$cshowList :: [GodotValue] -> ShowS
show :: GodotValue -> String
$cshow :: GodotValue -> String
showsPrec :: Int -> GodotValue -> ShowS
$cshowsPrec :: Int -> GodotValue -> ShowS
Show,(forall x. GodotValue -> Rep GodotValue x)
-> (forall x. Rep GodotValue x -> GodotValue) -> Generic GodotValue
forall x. Rep GodotValue x -> GodotValue
forall x. GodotValue -> Rep GodotValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GodotValue x -> GodotValue
$cfrom :: forall x. GodotValue -> Rep GodotValue x
Generic,GodotValue -> GodotValue -> Bool
(GodotValue -> GodotValue -> Bool)
-> (GodotValue -> GodotValue -> Bool) -> Eq GodotValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GodotValue -> GodotValue -> Bool
$c/= :: GodotValue -> GodotValue -> Bool
== :: GodotValue -> GodotValue -> Bool
$c== :: GodotValue -> GodotValue -> Bool
Eq)

-- There aren't any lenses to unwrap sum types AFAIK :/
-- Surely there's a better way to do this.
unGodotConstructor :: k -> HashMap k GodotValue -> Maybe (Text, [GodotValue])
unGodotConstructor k
k = (GodotValue -> (Text, [GodotValue]))
-> Maybe GodotValue -> Maybe (Text, [GodotValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotConstructor (Text
n, [GodotValue]
a)) -> (Text
n, [GodotValue]
a)) (Maybe GodotValue -> Maybe (Text, [GodotValue]))
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe (Text, [GodotValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotConstructor' :: k -> HashMap k GodotValue -> (Text, [GodotValue])
unGodotConstructor' k
k = Maybe (Text, [GodotValue]) -> (Text, [GodotValue])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Text, [GodotValue]) -> (Text, [GodotValue]))
-> (HashMap k GodotValue -> Maybe (Text, [GodotValue]))
-> HashMap k GodotValue
-> (Text, [GodotValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe (Text, [GodotValue])
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe (Text, [GodotValue])
unGodotConstructor k
k

unGodotInt :: k -> HashMap k GodotValue -> Maybe Int
unGodotInt k
k = (GodotValue -> Int) -> Maybe GodotValue -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotInt Int
i) -> Int
i) (Maybe GodotValue -> Maybe Int)
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotInt' :: k -> HashMap k GodotValue -> Int
unGodotInt' k
k = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int)
-> (HashMap k GodotValue -> Maybe Int)
-> HashMap k GodotValue
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe Int
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Int
unGodotInt k
k

unGodotFloat :: k -> HashMap k GodotValue -> Maybe Float
unGodotFloat k
k = (GodotValue -> Float) -> Maybe GodotValue -> Maybe Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotFloat Float
i) -> Float
i) (Maybe GodotValue -> Maybe Float)
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotFloat' :: k -> HashMap k GodotValue -> Int
unGodotFloat' k
k = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int)
-> (HashMap k GodotValue -> Maybe Int)
-> HashMap k GodotValue
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe Int
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Int
unGodotInt k
k

unGodotBool :: k -> HashMap k GodotValue -> Maybe Bool
unGodotBool k
k = (GodotValue -> Bool) -> Maybe GodotValue -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotBool Bool
i) -> Bool
i) (Maybe GodotValue -> Maybe Bool)
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotBool' :: k -> HashMap k GodotValue -> Bool
unGodotBool' k
k = Maybe Bool -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Bool -> Bool)
-> (HashMap k GodotValue -> Maybe Bool)
-> HashMap k GodotValue
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe Bool
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Bool
unGodotBool k
k

unGodotString :: k -> HashMap k GodotValue -> Maybe Text
unGodotString k
k = (GodotValue -> Text) -> Maybe GodotValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotString Text
i) -> Text
i) (Maybe GodotValue -> Maybe Text)
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotString' :: k -> HashMap k GodotValue -> Text
unGodotString' k
k = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text)
-> (HashMap k GodotValue -> Maybe Text)
-> HashMap k GodotValue
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString k
k

unGodotDict :: k -> HashMap k GodotValue -> Maybe (HashMap Text GodotValue)
unGodotDict k
k = (GodotValue -> HashMap Text GodotValue)
-> Maybe GodotValue -> Maybe (HashMap Text GodotValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotDict HashMap Text GodotValue
i) -> HashMap Text GodotValue
i) (Maybe GodotValue -> Maybe (HashMap Text GodotValue))
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe (HashMap Text GodotValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotDict' :: k -> HashMap k GodotValue -> HashMap Text GodotValue
unGodotDict' k
k = Maybe (HashMap Text GodotValue) -> HashMap Text GodotValue
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (HashMap Text GodotValue) -> HashMap Text GodotValue)
-> (HashMap k GodotValue -> Maybe (HashMap Text GodotValue))
-> HashMap k GodotValue
-> HashMap Text GodotValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe (HashMap Text GodotValue)
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe (HashMap Text GodotValue)
unGodotDict k
k

unGodotArr :: k -> HashMap k GodotValue -> Maybe [GodotValue]
unGodotArr k
k = (GodotValue -> [GodotValue])
-> Maybe GodotValue -> Maybe [GodotValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GodotArr [GodotValue]
i) -> [GodotValue]
i) (Maybe GodotValue -> Maybe [GodotValue])
-> (HashMap k GodotValue -> Maybe GodotValue)
-> HashMap k GodotValue
-> Maybe [GodotValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe GodotValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k

unGodotArr' :: k -> HashMap k GodotValue -> [GodotValue]
unGodotArr' k
k = Maybe [GodotValue] -> [GodotValue]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [GodotValue] -> [GodotValue])
-> (HashMap k GodotValue -> Maybe [GodotValue])
-> HashMap k GodotValue
-> [GodotValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> HashMap k GodotValue -> Maybe [GodotValue]
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe [GodotValue]
unGodotArr k
k

collectRest :: [a] -> HashMap a v -> HashMap a v
collectRest [a]
its = (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
M.filterWithKey (\a
k v
_ -> a
k a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [a]
its)

-- | Godot resource section prefixed with a bracket-enclosed header, optionally
-- with body entries.
--
-- Header entries not specified in a record are accessed with the relevant `headers` field.
-- Likewise, body entries not specified are accessed with the `entries` field.
-- Note that explicitly specified section fields are not duplicated in `headers` and
-- `entries` fields.
data GodotSection
  = ExtResourceSection
    { GodotSection -> Text
_extResourceSectionPath    :: T.Text
    , GodotSection -> Text
_extResourceSectionTy      :: T.Text
    , GodotSection -> Int
_extResourceSectionId      :: Int
      -- | Other header information.
    , GodotSection -> HashMap Text GodotValue
_extResourceSectionHeaders :: M.HashMap T.Text GodotValue
      -- | Body of the configuration entry.
    , GodotSection -> HashMap Text GodotValue
_extResourceSectionEntries :: M.HashMap T.Text GodotValue
    }
  | SubResourceSection
    { GodotSection -> Text
_subResourceSectionTy      :: T.Text
    , GodotSection -> Int
_subResourceSectionId      :: Int
      -- | Other header information.
    , GodotSection -> HashMap Text GodotValue
_subResourceSectionHeaders :: M.HashMap T.Text GodotValue
      -- | Body of the configuration entry.
    , GodotSection -> HashMap Text GodotValue
_subResourceSectionEntries :: M.HashMap T.Text GodotValue
    }
  | NodeSection
    { GodotSection -> Maybe Text
_nodeSectionTy :: Maybe T.Text
    , GodotSection -> Text
_nodeSectionName :: T.Text
      -- | If `Nothing`, then this node is the root.
    , GodotSection -> Maybe Text
_nodeSectionParent :: Maybe T.Text
      -- | Instance refers to an `ExtResource` ID, usually listed at the top of a file.
    , GodotSection -> Maybe Int
_nodeSectionInst :: Maybe Int
    , GodotSection -> Maybe Text
_nodeSectionInstPlaceholder :: Maybe T.Text
    , GodotSection -> Maybe Text
_nodeSectionOwner :: Maybe T.Text
    , GodotSection -> Maybe Int
_nodeSectionIndex :: Maybe Int
    , GodotSection -> Maybe [Text]
_nodeSectionGroups :: Maybe [T.Text]
      -- | Other header information.
    , GodotSection -> HashMap Text GodotValue
_nodeSectionHeaders :: M.HashMap T.Text GodotValue
      -- | Body of the configuration entry.
    , GodotSection -> HashMap Text GodotValue
_nodeSectionEntries :: M.HashMap T.Text GodotValue
    }
  | ConnectionSection
    { GodotSection -> Text
_connectionSectionSignal  :: T.Text
    , GodotSection -> Text
_connectionSectionFrom    :: T.Text
    , GodotSection -> Text
_connectionSectionTo      :: T.Text
    , GodotSection -> Text
_connectionSectionMethod  :: T.Text
      -- | Other header information.
    , GodotSection -> HashMap Text GodotValue
_connectionSectionHeaders :: M.HashMap T.Text GodotValue
      -- | Body of the configuration entry.
    , GodotSection -> HashMap Text GodotValue
_connectionSectionEntries :: M.HashMap T.Text GodotValue
    }
  | ResourceSection
    { GodotSection -> Maybe Text
_resourceSectionResourceName :: Maybe T.Text
    , GodotSection -> Maybe Text
_resourceSectionClassName    :: Maybe T.Text
    , GodotSection -> Maybe (Text, [GodotValue])
_resourceSectionLibrary      :: Maybe (T.Text, [GodotValue])
    }
  | OtherSection
    { GodotSection -> Text
_otherSectionHeader  :: T.Text
    , GodotSection -> HashMap Text GodotValue
_otherSectionHeaders :: M.HashMap T.Text GodotValue
    , GodotSection -> HashMap Text GodotValue
_otherSectionEntries :: M.HashMap T.Text GodotValue
    }
  deriving (Int -> GodotSection -> ShowS
[GodotSection] -> ShowS
GodotSection -> String
(Int -> GodotSection -> ShowS)
-> (GodotSection -> String)
-> ([GodotSection] -> ShowS)
-> Show GodotSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GodotSection] -> ShowS
$cshowList :: [GodotSection] -> ShowS
show :: GodotSection -> String
$cshow :: GodotSection -> String
showsPrec :: Int -> GodotSection -> ShowS
$cshowsPrec :: Int -> GodotSection -> ShowS
Show,(forall x. GodotSection -> Rep GodotSection x)
-> (forall x. Rep GodotSection x -> GodotSection)
-> Generic GodotSection
forall x. Rep GodotSection x -> GodotSection
forall x. GodotSection -> Rep GodotSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GodotSection x -> GodotSection
$cfrom :: forall x. GodotSection -> Rep GodotSection x
Generic)

-- | `tscn` file descriptor.
data TscnDescriptor =
  TscnDescriptor
  { TscnDescriptor -> Int
_tscnDescriptorLoadSteps :: Int
  , TscnDescriptor -> Int
_tscnDescriptorFormat    :: Int
  }
  deriving (Int -> TscnDescriptor -> ShowS
[TscnDescriptor] -> ShowS
TscnDescriptor -> String
(Int -> TscnDescriptor -> ShowS)
-> (TscnDescriptor -> String)
-> ([TscnDescriptor] -> ShowS)
-> Show TscnDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TscnDescriptor] -> ShowS
$cshowList :: [TscnDescriptor] -> ShowS
show :: TscnDescriptor -> String
$cshow :: TscnDescriptor -> String
showsPrec :: Int -> TscnDescriptor -> ShowS
$cshowsPrec :: Int -> TscnDescriptor -> ShowS
Show,(forall x. TscnDescriptor -> Rep TscnDescriptor x)
-> (forall x. Rep TscnDescriptor x -> TscnDescriptor)
-> Generic TscnDescriptor
forall x. Rep TscnDescriptor x -> TscnDescriptor
forall x. TscnDescriptor -> Rep TscnDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TscnDescriptor x -> TscnDescriptor
$cfrom :: forall x. TscnDescriptor -> Rep TscnDescriptor x
Generic)

-- | Parsed `tscn` file.
data TscnParsed =
  TscnParsed
  { TscnParsed -> TscnDescriptor
_tscnParsedDescriptor :: TscnDescriptor
  , TscnParsed -> [GodotSection]
_tscnParsedSections   :: [GodotSection]
  }
  deriving (Int -> TscnParsed -> ShowS
[TscnParsed] -> ShowS
TscnParsed -> String
(Int -> TscnParsed -> ShowS)
-> (TscnParsed -> String)
-> ([TscnParsed] -> ShowS)
-> Show TscnParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TscnParsed] -> ShowS
$cshowList :: [TscnParsed] -> ShowS
show :: TscnParsed -> String
$cshow :: TscnParsed -> String
showsPrec :: Int -> TscnParsed -> ShowS
$cshowsPrec :: Int -> TscnParsed -> ShowS
Show,(forall x. TscnParsed -> Rep TscnParsed x)
-> (forall x. Rep TscnParsed x -> TscnParsed) -> Generic TscnParsed
forall x. Rep TscnParsed x -> TscnParsed
forall x. TscnParsed -> Rep TscnParsed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TscnParsed x -> TscnParsed
$cfrom :: forall x. TscnParsed -> Rep TscnParsed x
Generic)

-- | `gdns` file descriptor.
data GdnsDescriptor =
  GdnsDescriptor
  { GdnsDescriptor -> Text
_gdnsDescriptorTy        :: T.Text
  , GdnsDescriptor -> Int
_gdnsDescriptorLoadSteps :: Int
  , GdnsDescriptor -> Int
_gdnsDescriptorFormat    :: Int
  }
  deriving (Int -> GdnsDescriptor -> ShowS
[GdnsDescriptor] -> ShowS
GdnsDescriptor -> String
(Int -> GdnsDescriptor -> ShowS)
-> (GdnsDescriptor -> String)
-> ([GdnsDescriptor] -> ShowS)
-> Show GdnsDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GdnsDescriptor] -> ShowS
$cshowList :: [GdnsDescriptor] -> ShowS
show :: GdnsDescriptor -> String
$cshow :: GdnsDescriptor -> String
showsPrec :: Int -> GdnsDescriptor -> ShowS
$cshowsPrec :: Int -> GdnsDescriptor -> ShowS
Show,(forall x. GdnsDescriptor -> Rep GdnsDescriptor x)
-> (forall x. Rep GdnsDescriptor x -> GdnsDescriptor)
-> Generic GdnsDescriptor
forall x. Rep GdnsDescriptor x -> GdnsDescriptor
forall x. GdnsDescriptor -> Rep GdnsDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GdnsDescriptor x -> GdnsDescriptor
$cfrom :: forall x. GdnsDescriptor -> Rep GdnsDescriptor x
Generic)

-- | Parsed `gdns` file.
data GdnsParsed =
  GdnsParsed
  { GdnsParsed -> GdnsDescriptor
_gdnsParsedDescriptor :: GdnsDescriptor
  , GdnsParsed -> [GodotSection]
_gdnsParsedSections   :: [GodotSection]
  }
  deriving (Int -> GdnsParsed -> ShowS
[GdnsParsed] -> ShowS
GdnsParsed -> String
(Int -> GdnsParsed -> ShowS)
-> (GdnsParsed -> String)
-> ([GdnsParsed] -> ShowS)
-> Show GdnsParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GdnsParsed] -> ShowS
$cshowList :: [GdnsParsed] -> ShowS
show :: GdnsParsed -> String
$cshow :: GdnsParsed -> String
showsPrec :: Int -> GdnsParsed -> ShowS
$cshowsPrec :: Int -> GdnsParsed -> ShowS
Show,(forall x. GdnsParsed -> Rep GdnsParsed x)
-> (forall x. Rep GdnsParsed x -> GdnsParsed) -> Generic GdnsParsed
forall x. Rep GdnsParsed x -> GdnsParsed
forall x. GdnsParsed -> Rep GdnsParsed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GdnsParsed x -> GdnsParsed
$cfrom :: forall x. GdnsParsed -> Rep GdnsParsed x
Generic)

-- | An unknown file descriptor.
data OtherDescriptor =
  OtherDescriptor
  { OtherDescriptor -> Text
_otherDescriptorHeaderName :: T.Text
  , OtherDescriptor -> HashMap Text GodotValue
_otherDescriptorHeaders    :: M.HashMap T.Text GodotValue
  }
  deriving (Int -> OtherDescriptor -> ShowS
[OtherDescriptor] -> ShowS
OtherDescriptor -> String
(Int -> OtherDescriptor -> ShowS)
-> (OtherDescriptor -> String)
-> ([OtherDescriptor] -> ShowS)
-> Show OtherDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherDescriptor] -> ShowS
$cshowList :: [OtherDescriptor] -> ShowS
show :: OtherDescriptor -> String
$cshow :: OtherDescriptor -> String
showsPrec :: Int -> OtherDescriptor -> ShowS
$cshowsPrec :: Int -> OtherDescriptor -> ShowS
Show,(forall x. OtherDescriptor -> Rep OtherDescriptor x)
-> (forall x. Rep OtherDescriptor x -> OtherDescriptor)
-> Generic OtherDescriptor
forall x. Rep OtherDescriptor x -> OtherDescriptor
forall x. OtherDescriptor -> Rep OtherDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherDescriptor x -> OtherDescriptor
$cfrom :: forall x. OtherDescriptor -> Rep OtherDescriptor x
Generic)

-- | An unknown file parsing result.
data OtherParsed =
  OtherParsed
  { OtherParsed -> OtherDescriptor
_otherParsedDescriptor :: OtherDescriptor
  , OtherParsed -> [GodotSection]
_otherParsedSections   :: [GodotSection]
  }
  deriving (Int -> OtherParsed -> ShowS
[OtherParsed] -> ShowS
OtherParsed -> String
(Int -> OtherParsed -> ShowS)
-> (OtherParsed -> String)
-> ([OtherParsed] -> ShowS)
-> Show OtherParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherParsed] -> ShowS
$cshowList :: [OtherParsed] -> ShowS
show :: OtherParsed -> String
$cshow :: OtherParsed -> String
showsPrec :: Int -> OtherParsed -> ShowS
$cshowsPrec :: Int -> OtherParsed -> ShowS
Show,(forall x. OtherParsed -> Rep OtherParsed x)
-> (forall x. Rep OtherParsed x -> OtherParsed)
-> Generic OtherParsed
forall x. Rep OtherParsed x -> OtherParsed
forall x. OtherParsed -> Rep OtherParsed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherParsed x -> OtherParsed
$cfrom :: forall x. OtherParsed -> Rep OtherParsed x
Generic)

-- | Parsed godot resource file.
data GodotParsed
  = Tscn TscnParsed
  | Gdns GdnsParsed
  | Other OtherParsed
  deriving (Int -> GodotParsed -> ShowS
[GodotParsed] -> ShowS
GodotParsed -> String
(Int -> GodotParsed -> ShowS)
-> (GodotParsed -> String)
-> ([GodotParsed] -> ShowS)
-> Show GodotParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GodotParsed] -> ShowS
$cshowList :: [GodotParsed] -> ShowS
show :: GodotParsed -> String
$cshow :: GodotParsed -> String
showsPrec :: Int -> GodotParsed -> ShowS
$cshowsPrec :: Int -> GodotParsed -> ShowS
Show,(forall x. GodotParsed -> Rep GodotParsed x)
-> (forall x. Rep GodotParsed x -> GodotParsed)
-> Generic GodotParsed
forall x. Rep GodotParsed x -> GodotParsed
forall x. GodotParsed -> Rep GodotParsed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GodotParsed x -> GodotParsed
$cfrom :: forall x. GodotParsed -> Rep GodotParsed x
Generic)

tscnHeaderKVP :: Parser (T.Text, GodotValue)
tscnHeaderKVP :: ParsecT Void Text Identity (Text, GodotValue)
tscnHeaderKVP = (Text -> GodotValue -> (Text, GodotValue))
-> Parser Text
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity (Text, GodotValue)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'=' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity GodotValue
godotValueP)

headerKvs :: Parser (M.HashMap T.Text GodotValue)
headerKvs :: Parser (HashMap Text GodotValue)
headerKvs = [(Text, GodotValue)] -> HashMap Text GodotValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, GodotValue)] -> HashMap Text GodotValue)
-> ParsecT Void Text Identity [(Text, GodotValue)]
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Text, GodotValue)
tscnHeaderKVP ParsecT Void Text Identity (Text, GodotValue)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [(Text, GodotValue)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`P.sepBy` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
' '

bodyAndKvs :: Parser (T.Text, M.HashMap T.Text GodotValue, M.HashMap T.Text GodotValue)
bodyAndKvs :: Parser (Text, HashMap Text GodotValue, HashMap Text GodotValue)
bodyAndKvs = do
  Text
headerName <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'[' ParsecT Void Text Identity Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser Text -> ParsecT Void Text Identity Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
' '
  HashMap Text GodotValue
headerKvs' <- Parser (HashMap Text GodotValue)
headerKvs
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']'
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  let tscnBodyP :: Parser (HashMap Text GodotValue)
tscnBodyP  = do
        let parseKV :: ParsecT Void Text Identity (Text, GodotValue)
parseKV =
              (Text -> GodotValue -> (Text, GodotValue))
-> Parser Text
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity (Text, GodotValue)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' '))
              (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
" = " Parser Text
-> ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity GodotValue
godotValueP ParsecT Void Text Identity GodotValue
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity GodotValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline)
        [(Text, GodotValue)] -> HashMap Text GodotValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, GodotValue)] -> HashMap Text GodotValue)
-> ParsecT Void Text Identity [(Text, GodotValue)]
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Text, GodotValue)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Text, GodotValue)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT Void Text Identity (Text, GodotValue)
parseKV (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline ParsecT Void Text Identity Char
-> () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)
      emptyBodyP :: ParsecT Void Text Identity (HashMap k v)
emptyBodyP = HashMap k v -> ParsecT Void Text Identity (HashMap k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap k v
forall k v. HashMap k v
M.empty
  HashMap Text GodotValue
body <- Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser (HashMap Text GodotValue)
tscnBodyP Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser (HashMap Text GodotValue)
forall k v. ParsecT Void Text Identity (HashMap k v)
emptyBodyP
  (Text
headerName, HashMap Text GodotValue
headerKvs', HashMap Text GodotValue
body) (Text, HashMap Text GodotValue, HashMap Text GodotValue)
-> ParsecT Void Text Identity ()
-> Parser (Text, HashMap Text GodotValue, HashMap Text GodotValue)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space

-- | Parse a section header nam, header key-values, and body key-values using a provided
-- conversion function.
headerWrapper
  :: T.Text
  -> (M.HashMap T.Text GodotValue -> M.HashMap T.Text GodotValue -> GodotSection)
  -> Parser GodotSection
headerWrapper :: Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
targetSect HashMap Text GodotValue -> HashMap Text GodotValue -> GodotSection
p = do
  (Text
headerName, HashMap Text GodotValue
headerKvs', HashMap Text GodotValue
bodyKvs) <- Parser (Text, HashMap Text GodotValue, HashMap Text GodotValue)
bodyAndKvs
  Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
headerName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
targetSect) (String -> ParsecT Void Text Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mismatched expected header")
  GodotSection -> Parser GodotSection
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GodotSection -> Parser GodotSection)
-> GodotSection -> Parser GodotSection
forall a b. (a -> b) -> a -> b
$ HashMap Text GodotValue -> HashMap Text GodotValue -> GodotSection
p HashMap Text GodotValue
headerKvs' HashMap Text GodotValue
bodyKvs

-- | Parse a `[sub_resource]` section.
tscnSubResourceP :: Parser GodotSection
tscnSubResourceP :: Parser GodotSection
tscnSubResourceP =
  Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
"sub_resource"
  (\HashMap Text GodotValue
kvs HashMap Text GodotValue
bodyKvs -> Text
-> Int
-> HashMap Text GodotValue
-> HashMap Text GodotValue
-> GodotSection
SubResourceSection (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"type" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"id" HashMap Text GodotValue
kvs)
   ([Text] -> HashMap Text GodotValue -> HashMap Text GodotValue
forall a v. (Eq a, Hashable a) => [a] -> HashMap a v -> HashMap a v
collectRest [Text
"type", Text
"id"] HashMap Text GodotValue
kvs) HashMap Text GodotValue
bodyKvs)

-- | Parse an `[ext_resource]` section.
tscnExtResourceP :: Parser GodotSection
tscnExtResourceP :: Parser GodotSection
tscnExtResourceP =
  Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
"ext_resource"
  (\HashMap Text GodotValue
kvs HashMap Text GodotValue
bodyKvs -> Text
-> Text
-> Int
-> HashMap Text GodotValue
-> HashMap Text GodotValue
-> GodotSection
ExtResourceSection (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"path" HashMap Text GodotValue
kvs)
   (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"type" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"id" HashMap Text GodotValue
kvs)
   ([Text] -> HashMap Text GodotValue -> HashMap Text GodotValue
forall a v. (Eq a, Hashable a) => [a] -> HashMap a v -> HashMap a v
collectRest [Text
"path", Text
"type", Text
"id"] HashMap Text GodotValue
kvs) HashMap Text GodotValue
bodyKvs)

-- | Parse a `[node]` section.
tscnNodeP :: Parser GodotSection
tscnNodeP :: Parser GodotSection
tscnNodeP =
  Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
"node"
  (\HashMap Text GodotValue
kvs HashMap Text GodotValue
bodyKvs -> Maybe Text
-> Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe [Text]
-> HashMap Text GodotValue
-> HashMap Text GodotValue
-> GodotSection
NodeSection (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"type" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"name" HashMap Text GodotValue
kvs)
   (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"parent" HashMap Text GodotValue
kvs)
   ((\(GodotInt Int
i) -> Int
i) (GodotValue -> Int)
-> ((Text, [GodotValue]) -> GodotValue)
-> (Text, [GodotValue])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GodotValue] -> GodotValue
forall a. [a] -> a
head ([GodotValue] -> GodotValue)
-> ((Text, [GodotValue]) -> [GodotValue])
-> (Text, [GodotValue])
-> GodotValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [GodotValue]) -> [GodotValue]
forall a b. (a, b) -> b
snd ((Text, [GodotValue]) -> Int)
-> Maybe (Text, [GodotValue]) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text GodotValue -> Maybe (Text, [GodotValue])
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe (Text, [GodotValue])
unGodotConstructor Text
"instance" HashMap Text GodotValue
kvs)
   (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"instance_placeholder" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"owner" HashMap Text GodotValue
kvs)
   (Text -> HashMap Text GodotValue -> Maybe Int
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Int
unGodotInt Text
"index" HashMap Text GodotValue
kvs) ((GodotValue -> Text) -> [GodotValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(GodotString Text
i) -> Text
i) ([GodotValue] -> [Text]) -> Maybe [GodotValue] -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text GodotValue -> Maybe [GodotValue]
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe [GodotValue]
unGodotArr Text
"groups" HashMap Text GodotValue
kvs)
   ([Text] -> HashMap Text GodotValue -> HashMap Text GodotValue
forall a v. (Eq a, Hashable a) => [a] -> HashMap a v -> HashMap a v
collectRest
    [ Text
"path"
    , Text
"type"
    , Text
"parent"
    , Text
"name"
    , Text
"instance"
    , Text
"instance_placeholder"
    , Text
"owner"
    , Text
"index"
    , Text
"groups"] HashMap Text GodotValue
kvs) HashMap Text GodotValue
bodyKvs)

-- | Parse a `[connection]` section.
tscnConnectionP :: Parser GodotSection
tscnConnectionP :: Parser GodotSection
tscnConnectionP =
  Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
"connection"
  (\HashMap Text GodotValue
kvs HashMap Text GodotValue
bodyKvs -> Text
-> Text
-> Text
-> Text
-> HashMap Text GodotValue
-> HashMap Text GodotValue
-> GodotSection
ConnectionSection (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"signal" HashMap Text GodotValue
kvs)
   (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"from" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"to" HashMap Text GodotValue
kvs) (Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"method" HashMap Text GodotValue
kvs)
   ([Text] -> HashMap Text GodotValue -> HashMap Text GodotValue
forall a v. (Eq a, Hashable a) => [a] -> HashMap a v -> HashMap a v
collectRest [Text
"signal", Text
"from", Text
"to", Text
"method"] HashMap Text GodotValue
kvs) HashMap Text GodotValue
bodyKvs)

-- | Parse an unspecified section.
otherP :: Parser GodotSection
otherP :: Parser GodotSection
otherP = do
  (Text
headerName, HashMap Text GodotValue
headerKvs', HashMap Text GodotValue
bodyKvs) <- Parser (Text, HashMap Text GodotValue, HashMap Text GodotValue)
bodyAndKvs
  GodotSection -> Parser GodotSection
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GodotSection -> Parser GodotSection)
-> GodotSection -> Parser GodotSection
forall a b. (a -> b) -> a -> b
$ Text
-> HashMap Text GodotValue
-> HashMap Text GodotValue
-> GodotSection
OtherSection Text
headerName HashMap Text GodotValue
headerKvs' HashMap Text GodotValue
bodyKvs

-- | Parse a `tscn` file.
tscnParser :: Parser TscnParsed
tscnParser :: Parser TscnParsed
tscnParser = do
  HashMap Text GodotValue
kvs <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"[gd_scene " Parser Text
-> Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (HashMap Text GodotValue)
headerKvs Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity Char
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']' Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity ()
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  let loadSteps :: Int
loadSteps = Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"load_steps" HashMap Text GodotValue
kvs
      format :: Int
format    = Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"format" HashMap Text GodotValue
kvs
      sectionP :: Parser GodotSection
sectionP  =
        [Parser GodotSection] -> Parser GodotSection
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
        ((Parser GodotSection -> Parser GodotSection)
-> [Parser GodotSection] -> [Parser GodotSection]
forall a b. (a -> b) -> [a] -> [b]
map Parser GodotSection -> Parser GodotSection
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try
         [Parser GodotSection
tscnConnectionP, Parser GodotSection
tscnExtResourceP, Parser GodotSection
tscnSubResourceP, Parser GodotSection
tscnNodeP, Parser GodotSection
otherP])
  [GodotSection]
sections <- Parser GodotSection
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [GodotSection]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser GodotSection
sectionP ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
  TscnParsed -> Parser TscnParsed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TscnParsed -> Parser TscnParsed)
-> TscnParsed -> Parser TscnParsed
forall a b. (a -> b) -> a -> b
$ TscnDescriptor -> [GodotSection] -> TscnParsed
TscnParsed (Int -> Int -> TscnDescriptor
TscnDescriptor Int
loadSteps Int
format) [GodotSection]
sections

-- | Parse a `[resource]` section.
resourceP :: Parser GodotSection
resourceP :: Parser GodotSection
resourceP =
  Text
-> (HashMap Text GodotValue
    -> HashMap Text GodotValue -> GodotSection)
-> Parser GodotSection
headerWrapper Text
"resource"
  (\HashMap Text GodotValue
_ HashMap Text GodotValue
bodyKvs -> Maybe Text
-> Maybe Text -> Maybe (Text, [GodotValue]) -> GodotSection
ResourceSection (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"resource_name" HashMap Text GodotValue
bodyKvs)
   (Text -> HashMap Text GodotValue -> Maybe Text
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe Text
unGodotString Text
"class_name" HashMap Text GodotValue
bodyKvs) (Text -> HashMap Text GodotValue -> Maybe (Text, [GodotValue])
forall k.
(Eq k, Hashable k) =>
k -> HashMap k GodotValue -> Maybe (Text, [GodotValue])
unGodotConstructor Text
"library" HashMap Text GodotValue
bodyKvs))

-- | Parse a `gdns` file.
gdnsParser :: Parser GdnsParsed
gdnsParser :: Parser GdnsParsed
gdnsParser = do
  HashMap Text GodotValue
kvs <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"[gd_resource " Parser Text
-> Parser (HashMap Text GodotValue)
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (HashMap Text GodotValue)
headerKvs Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity Char
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']' Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity ()
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  let ty :: Text
ty        = Text -> HashMap Text GodotValue -> Text
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Text
unGodotString' Text
"type" HashMap Text GodotValue
kvs
      loadSteps :: Int
loadSteps = Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"load_steps" HashMap Text GodotValue
kvs
      format :: Int
format    = Text -> HashMap Text GodotValue -> Int
forall k. (Eq k, Hashable k) => k -> HashMap k GodotValue -> Int
unGodotInt' Text
"format" HashMap Text GodotValue
kvs
      sectionP :: Parser GodotSection
sectionP  = [Parser GodotSection] -> Parser GodotSection
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice ((Parser GodotSection -> Parser GodotSection)
-> [Parser GodotSection] -> [Parser GodotSection]
forall a b. (a -> b) -> [a] -> [b]
map Parser GodotSection -> Parser GodotSection
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try [Parser GodotSection
tscnExtResourceP, Parser GodotSection
resourceP, Parser GodotSection
otherP])
  [GodotSection]
sections <- Parser GodotSection
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [GodotSection]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser GodotSection
sectionP ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
  GdnsParsed -> Parser GdnsParsed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GdnsParsed -> Parser GdnsParsed)
-> GdnsParsed -> Parser GdnsParsed
forall a b. (a -> b) -> a -> b
$ GdnsDescriptor -> [GodotSection] -> GdnsParsed
GdnsParsed (Text -> Int -> Int -> GdnsDescriptor
GdnsDescriptor Text
ty Int
loadSteps Int
format) [GodotSection]
sections

-- | Parse an unknown resource file.
otherParser :: Parser OtherParsed
otherParser :: Parser OtherParsed
otherParser = do
  Text
hName <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'[' ParsecT Void Text Identity Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Parser Text -> ParsecT Void Text Identity Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
' '
  HashMap Text GodotValue
hKvs <- Parser (HashMap Text GodotValue)
headerKvs Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity Char
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
']' Parser (HashMap Text GodotValue)
-> ParsecT Void Text Identity ()
-> Parser (HashMap Text GodotValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
  [GodotSection]
sections <- Parser GodotSection
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [GodotSection]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill Parser GodotSection
otherP ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
  OtherParsed -> Parser OtherParsed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OtherParsed -> Parser OtherParsed)
-> OtherParsed -> Parser OtherParsed
forall a b. (a -> b) -> a -> b
$ OtherDescriptor -> [GodotSection] -> OtherParsed
OtherParsed (Text -> HashMap Text GodotValue -> OtherDescriptor
OtherDescriptor Text
hName HashMap Text GodotValue
hKvs) [GodotSection]
sections

-- | Parse some Godot resource file.
godotParser :: Parser GodotParsed
godotParser :: Parser GodotParsed
godotParser =
  [Parser GodotParsed] -> Parser GodotParsed
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice ((Parser GodotParsed -> Parser GodotParsed)
-> [Parser GodotParsed] -> [Parser GodotParsed]
forall a b. (a -> b) -> [a] -> [b]
map Parser GodotParsed -> Parser GodotParsed
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try [TscnParsed -> GodotParsed
Tscn (TscnParsed -> GodotParsed)
-> Parser TscnParsed -> Parser GodotParsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TscnParsed
tscnParser, GdnsParsed -> GodotParsed
Gdns (GdnsParsed -> GodotParsed)
-> Parser GdnsParsed -> Parser GodotParsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GdnsParsed
gdnsParser, OtherParsed -> GodotParsed
Other (OtherParsed -> GodotParsed)
-> Parser OtherParsed -> Parser GodotParsed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OtherParsed
otherParser])