godot-megaparsec 0.2.2.0 → 0.2.5.0
raw patch · 5 files changed
+476/−447 lines, 5 filesdep +generic-lensdep +mtldep ~lensdep ~megaparsecdep ~text
Dependencies added: generic-lens, mtl
Dependency ranges changed: lens, megaparsec, text, unordered-containers
Files
- CHANGELOG.md +0/−5
- bench/Main.hs +16/−16
- godot-megaparsec.cabal +13/−14
- src/Godot/Parser/Resource.hs +447/−374
- src/Godot/Parser/Resource/Lens.hs +0/−38
− CHANGELOG.md
@@ -1,5 +0,0 @@-# Revision history for tscn-attoparsec--## 0.1.0.0 -- YYYY-mm-dd--* First version. Released on an unsuspecting world.
bench/Main.hs view
@@ -2,22 +2,22 @@ module Main where -import Criterion.Main--import Data.Either (fromRight)-import qualified Data.Text.IO as T--import Godot.Parser.Resource--import qualified Text.Megaparsec as P+import Criterion.Main+import qualified Data.Text.IO as T+import Godot.Parser.Resource+import qualified Text.Megaparsec as P main :: IO () main = do- let parseFile f =- fromRight (error $ "Unable to parse " <> f) . P.parse godotParser ""- <$> T.readFile f- defaultMain [ bench "EntityMap" $ whnfIO (parseFile "bench/EntityMap.tscn")- , bench "Geography" $ whnfIO (parseFile "bench/Geography.tscn")- , bench "MarketActor" $ whnfIO (parseFile "bench/MarketActor.tscn")- , bench "Other" $ whnfIO (parseFile "bench/Other.other")- , bench "BigFile" $ whnfIO (parseFile "bench/BigFile.tscn")]+ let parseFile f = do+ txt <- T.readFile f+ case P.parse parsedP "" txt of+ Right p -> pure p+ Left e -> putStrLn (P.errorBundlePretty e) >> undefined+ defaultMain+ [ bench "EntityMap" $ whnfIO (parseFile "bench/EntityMap.tscn")+ , bench "Geography" $ whnfIO (parseFile "bench/Geography.tscn")+ , bench "MarketActor" $ whnfIO (parseFile "bench/MarketActor.tscn")+ , bench "Other" $ whnfIO (parseFile "bench/Other.other")+ , bench "BigFile" $ whnfIO (parseFile "bench/BigFile.tscn")+ ]
godot-megaparsec.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.4 name: godot-megaparsec-version: 0.2.2.0+version: 0.2.5.0 -- A short (one-line) description of the package.-synopsis: Megaparsec parser for Godot `tscn` and `gdns` files.+synopsis: Megaparsec parser for Godot `tscn` and `gdextension` files. -- A longer description of the package. description:- Megaparsec parser for Godot `tscn` and `gdns` files.+ Megaparsec parser for Godot `tscn` and `gdextension` files. Currently only supports auto-generated files (i.e. files generated by the editor). Probably could parse other resource files, as they share similar formats. @@ -22,29 +22,28 @@ -- A copyright notice. -- copyright: BSD3-CLAUSE category: library-extra-source-files: CHANGELOG.md source-repository head type: git location: https://github.com/WinstonHartnett/godot-megaparsec.git library- exposed-modules:- Godot.Parser.Resource- Godot.Parser.Resource.Lens+ exposed-modules: Godot.Parser.Resource -- Modules included in this library but not exported. -- other-modules: -- LANGUAGE extensions used by modules in this package. -- other-extensions:- ghc-options: -Wall+ ghc-options: -Wall -fexpose-all-unfoldings build-depends: , base >= 4.14.0 && < 5- , lens >= 5.0.1 && < 5.1- , megaparsec >= 9.2.0 && < 9.3- , text >= 1.2.4 && < 1.3- , unordered-containers >= 0.2.14 && < 0.3+ , generic-lens+ , lens >= 5.0.1 && < 6+ , megaparsec >= 9.2.0 && < 10+ , mtl+ , text >= 1.2.4 && < 2.2+ , unordered-containers >= 0.2.14 && < 1 hs-source-dirs: src default-language: Haskell2010@@ -58,5 +57,5 @@ , base >= 4.14.0 && < 5 , criterion >= 1.5.11 && < 1.6 , godot-megaparsec- , megaparsec >= 9.2.0 && < 9.3- , text >= 1.2.4 && < 1.3+ , megaparsec >= 9.2.0 && < 9.3+ , text >= 1.2.4 && < 1.3
src/Godot/Parser/Resource.hs view
@@ -1,440 +1,513 @@-{-|+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++{- | 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+Description : Parser for Godot resource files.+Copyright : (c) Winston Hartnett, 2022+License : MIT+Maintainer : winstonhartnett@gmail.com Stability : experimental Portability : POSIX -A parser for Godot resource file formats. Currently only supports auto-generated-`tscn` and `gdns` files.--}-{-# LANGUAGE DeriveGeneric #-}+Godot's resource files are automatically generated by the editor. This parser+only supports automatically generated resource files for -{-# LANGUAGE OverloadedStrings #-}+ - Nodes with 'nodeP'+ - GDExtension configs with 'gdExtensionP'+ - Other resource files with 'otherP'+-}+module Godot.Parser.Resource (+ Parser,+ KvAnn,+ GdValue (..), -module Godot.Parser.Resource- (GodotValue(..)- ,GodotSection(..)- ,TscnDescriptor(..)- ,TscnParsed(..)- ,OtherDescriptor(..)- ,OtherParsed(..)- ,GdnsDescriptor(..)- ,GdnsParsed(..)- ,GodotParsed(..)- ,ExtResource(..)- ,SubResource(..)- ,Node(..)- ,Connection(..)- ,Resource(..)- ,tscnParser- ,gdnsParser- ,otherParser- ,godotParser) where+ -- * Value parsers+ valP,+ floatP,+ intP,+ boolP,+ stringP,+ arrP,+ dictP,+ cstrP,+ nullP, -import Control.Applicative ((<|>),liftA2)-import Control.Monad (unless)+ -- * Resource file parsers+ headerP,+ bodyP,+ bodyHeaderP, -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+ -- ** Resource file formats+ ExtResource (..),+ extResourceP,+ SubResource (..),+ subResourceP,+ Node (..),+ nodeP,+ Connection (..),+ connectionP,+ Resource (..),+ resourceP,+ GdSection (..),+ otherP,+ TscnParsed (..),+ tscnP,+ GdExtensionParsed (..),+ gdExtensionP,+ UnknownParsed (..),+ unknownP, -import GHC.Generics (Generic)+ -- * General resource file parsing+ GdParsed (..),+ parsedP,+) where -import Prelude hiding (exponent)+import Control.Applicative (asum, (<|>))+import Control.Lens hiding (from, to)+import Control.Monad.State.Strict (MonadState (get), MonadTrans (lift), StateT (runStateT), modify')+import Data.Char (isAlphaNum, isDigit, isUpper)+import Data.Either (fromRight)+import Data.Functor (($>))+import Data.Generics.Labels ()+import Data.Generics.Sum+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Data.Maybe (fromJust)+import qualified Data.Text as T+import qualified Data.Text.Read as T+import Data.Void (Void)+import GHC.Generics (Generic) -import qualified Text.Megaparsec as P-import qualified Text.Megaparsec.Char as P-import qualified Text.Megaparsec.Char.Lexer as P (decimal,signed)+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 = P.string "-" <|> P.string "+"+-- | Wrapped Godot resource format values.+data GdValue+ = GdCstr (T.Text, [GdValue])+ | GdInt Int+ | GdFloat Double+ | GdBool Bool+ | GdString T.Text+ | GdDict (HM.HashMap T.Text GdValue)+ | GdArr [GdValue]+ | GdNull+ deriving (Show, Generic) -godotFloatP :: Parser Float-godotFloatP = do- sign <- P.option "" optionalSign- let takeDigits = P.takeWhile1P Nothing isDigit- rational <- takeDigits <> P.string "." <> takeDigits- exponent <- P.option "" (P.string "e" <> P.option "" optionalSign <> takeDigits)- pure . fst . fromRight undefined . T.rational $ sign <> rational <> exponent+infixl 3 <||>+(<||>) :: Parser a -> Parser a -> Parser a+a <||> b = P.try a <|> P.try b -godotIntP :: Parser Int-godotIntP = P.signed P.space P.decimal+-------------------------------------------------------------------------------- -godotBoolP :: Parser Bool-godotBoolP = (P.string "true" $> True) <|> (P.string "false" $> False)+-- | Parse any resource value.+valP :: Parser GdValue+valP = asum $ map (\(t, p) -> (P.try $ P.lookAhead (P.satisfy t) *> p)) ms+ where+ ms =+ [ ((== '"'), GdString <$> stringP)+ , ((== '['), GdArr <$> arrP)+ , ((== '{'), GdDict <$> dictP)+ , (\c -> c == 't' || c == 'f', GdBool <$> boolP)+ , ((== 'n'), nullP)+ , (\c -> isUpper c || c == '@', GdCstr <$> cstrP)+ , (const True, P.try (GdFloat <$> floatP) <|> P.try (GdInt <$> intP))+ ] -stringP :: Parser T.Text-stringP = P.char '"' *> P.takeWhileP Nothing (/= '"') <* P.char '"'+-- | Parse resource float.+floatP :: Parser Double+floatP = do+ sign <- opt optSign+ rational <- takeDigits <> P.string "." <> takeDigits+ exponent' <- opt $ P.string "e" <> opt optSign <> takeDigits+ pure+ . fst+ . fromRight undefined+ . T.rational+ $ sign <> rational <> exponent'+ where+ optSign = P.string "-" <|> P.string "+"+ opt = P.option ""+ takeDigits = P.takeWhile1P Nothing isDigit -godotStringP :: Parser T.Text-godotStringP = stringP+-- | Parser resource int.+intP :: Parser Int+intP = P.signed P.space P.decimal -godotArrP :: Parser [GodotValue]-godotArrP = do- P.char '['- P.space- P.manyTill (do- gVal <- godotValueP- P.char ','- P.space- pure gVal) (P.char ']')+-- | Parse resource bool.+boolP :: Parser Bool+boolP = (P.string "true" $> True) <|> (P.string "false" $> False) -godotDictP :: Parser (M.HashMap T.Text GodotValue)-godotDictP = do- P.char '{'- P.space- let kvParser = liftA2 (,) stringP (P.char ':' *> P.hspace *> godotValueP)- kvs <- kvParser `P.sepBy` (P.char ',' *> P.newline *> P.hspace)- P.space- P.char '}'- pure . M.fromList $ kvs+-- Parse resource string.+stringP :: Parser T.Text+stringP = qt *> P.takeWhileP Nothing (/= '"') <* qt+ where+ qt = P.char '"' -godotConstructorP :: Parser (T.Text, [GodotValue])-godotConstructorP = do- let isGodotIdent c = isAlphaNum c || c == '@'- constructorName- <- P.takeWhile1P Nothing isGodotIdent -- TODO Causes problems w/ other delimiters- P.char '('- P.space- constructorArgs <- godotValueP `P.sepBy` (P.char ',' *> P.hspace)- P.space- P.char ')'- pure (constructorName, constructorArgs)+-- | Parse array of resource values.+arrP :: Parser [GdValue]+arrP = do+ P.char '[' *> P.space+ flip P.manyTill (P.char ']') $+ valP <* P.char ',' <* P.space -godotNullP :: Parser GodotValue-godotNullP = P.string "null" $> GodotNull+-- | Parse dictionary of resource values.+dictP :: Parser (HM.HashMap T.Text GdValue)+dictP = P.between (P.char '{' *> P.space) (P.space *> P.char '}') kvs+ where+ kvs = fmap HM.fromList $ kvP `P.sepBy` (P.char ',' *> P.newline *> P.hspace)+ kvP = (,) <$> stringP <*> (P.char ':' *> P.hspace *> valP) -godotValueP :: Parser GodotValue-godotValueP = do- nc <- T.head . P.stateInput <$> P.getParserState- case nc of- '"' -> GodotString <$> godotStringP- '[' -> GodotArr <$> godotArrP- '{' -> GodotDict <$> godotDictP- 't' -> GodotBool <$> godotBoolP- 'f' -> GodotBool <$> godotBoolP- 'n' -> godotNullP- l- | isUpper l || l == '@' -> GodotConstructor <$> godotConstructorP- _ -> P.try (GodotFloat <$> godotFloatP) <|> P.try (GodotInt <$> godotIntP)+-- | Parse resource constructor.+cstrP :: Parser (T.Text, [GdValue])+cstrP = do+ cstrName <- cstrNameP+ cstrArgs <-+ P.between+ (P.char '(' *> P.space)+ (P.space *> P.char ')')+ cstrArgsP+ pure (cstrName, cstrArgs)+ where+ isGdIdent c = isAlphaNum c || c == '@'+ cstrNameP = P.takeWhile1P Nothing isGdIdent+ cstrArgsP = valP `P.sepBy` (P.char ',' *> P.hspace) --- | 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 (Show,Generic,Eq)+-- | Parse null.+nullP :: Parser GdValue+nullP = P.string "null" $> GdNull --- There aren't any lenses to unwrap sum types AFAIK :/--- Surely there's a better way to do this.-unGodotConstructor k = fmap (\(GodotConstructor (n, a)) -> (n, a)) . M.lookup k+-------------------------------------------------------------------------------- -unGodotConstructor' k = fromJust . unGodotConstructor k+-- | A generic mapping from either a header or body key to a 'GdValue'.+type KvAnn = HM.HashMap T.Text GdValue -unGodotInt k = fmap (\(GodotInt i) -> i) . M.lookup k+-- | Parse resource header keys-values.+headerKvsP :: Parser KvAnn+headerKvsP = HM.fromList <$> kvP `P.sepBy` P.char ' '+ where+ kvP = (,) <$> P.takeWhileP Nothing (/= '=') <*> (P.char '=' *> valP) -unGodotInt' k = fromJust . unGodotInt k+-- | Parse a resource header.+headerP :: Parser (T.Text, KvAnn)+headerP = do+ name' <- P.char '[' *> P.takeWhile1P Nothing (/= ' ') <* P.char ' '+ kvs <- headerKvsP+ pure (name', kvs) -unGodotFloat k = fmap (\(GodotFloat i) -> i) . M.lookup k+-- | Parse resource body.+bodyP :: Parser KvAnn+bodyP = HM.fromList <$> P.manyTill kvP ((P.newline $> ()) <||> P.eof)+ where+ kvP =+ (,)+ <$> P.takeWhile1P Nothing (/= ' ')+ <*> (P.string " = " *> valP <* P.newline) -unGodotFloat' k = fromJust . unGodotInt k+-- | Parse body and header keys.+bodyHeaderP :: Parser (T.Text, KvAnn, KvAnn)+bodyHeaderP = do+ (headerName', headerKvs') <- headerP+ P.char ']' *> P.space+ body <- bodyP <||> mempty+ (headerName', headerKvs', body) <$ P.space -unGodotBool k = fmap (\(GodotBool i) -> i) . M.lookup k+type Consumer = StateT (KvAnn, KvAnn, HS.HashSet T.Text, HS.HashSet T.Text) Maybe -unGodotBool' k = fromJust . unGodotBool k+{- |+Parser for a headered Godot file. -unGodotString k = fmap (\(GodotString i) -> i) . M.lookup k+'Consumer' is a wrapper that tracks which keys of the generic key-value+maps for the header and body were processed. Processed keys won't appear in the+generic 'headers' and 'entries' sections of output data.+-}+headeredP :: T.Text -> Consumer (KvAnn -> KvAnn -> a) -> Parser a+headeredP sc p = do+ (headerName', headerKvs, bodyKvs) <- bodyHeaderP+ let kvRes = runStateT p (headerKvs, bodyKvs, mempty, mempty)+ if headerName' == sc+ then case kvRes of+ Just (s, (headerKvs', bodyKvs', consumedHeader, consumedBody)) ->+ pure $ s (collectRest consumedHeader headerKvs') (collectRest consumedBody bodyKvs')+ Nothing -> fail $ "parser interior failed"+ else fail "mismatch expected header"+ where+ collectRest its = HM.filterWithKey (\k _ -> not $ k `HS.member` its) -unGodotString' k = fromJust . unGodotString k+-------------------------------------------------------------------------------- -unGodotDict k = fmap (\(GodotDict i) -> i) . M.lookup k+{- |+Some Lens trickery that matches a key with a particular 'GdValue'+constructor, unwraps it, and marks it as processed in 'Consumer'.+-}+jq ::+ forall c s a b.+ (At s, AsConstructor c (IxValue s) (IxValue s) a a) =>+ Index s ->+ (Maybe a -> b) ->+ s ->+ b+jq k f h = f $ h ^? at k . _Just . _Ctor @c -unGodotDict' k = fromJust . unGodotDict k+-- | Match a key from the header.+jh ::+ forall c a.+ (AsConstructor c (IxValue KvAnn) (IxValue KvAnn) a a) =>+ Index KvAnn ->+ Consumer a+jh k = do+ modify' (over _3 (HS.insert k))+ jq @c k lift . view _1 =<< get -unGodotArr k = fmap (\(GodotArr i) -> i) . M.lookup k+-- | Optionally match a key from the header.+jh' ::+ forall c a.+ (AsConstructor c (IxValue KvAnn) (IxValue KvAnn) a a) =>+ Index KvAnn ->+ Consumer (Maybe a)+jh' k = do+ res <- jq @c k id . view _1 <$> get+ case res of+ Just r -> do+ modify' (over _3 (HS.insert k))+ pure $ Just r+ Nothing -> pure Nothing -unGodotArr' k = fromJust . unGodotArr k+-- | Match a key from the body.+jb ::+ forall c a.+ (AsConstructor c (IxValue KvAnn) (IxValue KvAnn) a a) =>+ Index KvAnn ->+ Consumer a+jb k = jq @c k lift . view _2 =<< get -collectRest its = M.filterWithKey (\k _ -> k `S.member` S.fromList its)+-- | Optionally match a key from the body.+jb' ::+ forall c a.+ (AsConstructor c (IxValue KvAnn) (IxValue KvAnn) a a) =>+ Index KvAnn ->+ Consumer (Maybe a)+jb' k = do+ res <- jq @c k id . view _2 <$> get+ case res of+ Just r -> do+ modify' (over _4 (HS.insert k))+ pure $ Just r+ Nothing -> pure Nothing -data ExtResource =- ExtResource- { _extResourcePath :: T.Text- , _extResourceTy :: T.Text- , _extResourceId :: Int- -- | Other header information.- , _extResourceHeaders :: M.HashMap T.Text GodotValue- -- | Body of the configuration entry.- , _extResourceEntries :: M.HashMap T.Text GodotValue- }- deriving (Show, Generic)+-------------------------------------------------------------------------------- -data SubResource =- SubResource- { _subResourceTy :: T.Text- , _subResourceId :: Int- -- | Other header information.- , _subResourceHeaders :: M.HashMap T.Text GodotValue- -- | Body of the configuration entry.- , _subResourceEntries :: M.HashMap T.Text GodotValue+data ExtResource = MkExtResource+ { path :: T.Text+ , type' :: T.Text+ , id' :: Int+ , headers :: KvAnn+ , entries :: KvAnn } deriving (Show, Generic) -data Node =- Node- { _nodeTy :: Maybe T.Text- , _nodeName :: T.Text- -- | If `Nothing`, then this node is the root.- , _nodeParent :: Maybe T.Text- -- | Instance refers to an `ExtResource` ID, usually listed at the top of a file.- , _nodeInst :: Maybe Int- , _nodeInstPlaceholder :: Maybe T.Text- , _nodeOwner :: Maybe T.Text- , _nodeIndex :: Maybe Int- , _nodeGroups :: Maybe [T.Text]- -- | Other header information.- , _nodeHeaders :: M.HashMap T.Text GodotValue- -- | Body of the configuration entry.- , _nodeEntries :: M.HashMap T.Text GodotValue- }- deriving (Show, Generic)--data Connection =- Connection- { _connectionSignal :: T.Text- , _connectionFrom :: T.Text- , _connectionTo :: T.Text- , _connectionMethod :: T.Text- -- | Other header information.- , _connectionHeaders :: M.HashMap T.Text GodotValue- -- | Body of the configuration entry.- , _connectionEntries :: M.HashMap T.Text GodotValue- }- deriving (Show, Generic)--data Resource =- Resource- { _resourceResourceName :: Maybe T.Text- , _resourceClassName :: Maybe T.Text- , _resourceLibrary :: Maybe (T.Text, [GodotValue])- }- deriving (Show, Generic)---- | 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 ExtResource- | SubResourceSection SubResource- | NodeSection Node- | ConnectionSection Connection- | ResourceSection Resource- | OtherSection- { _otherSectionHeader :: T.Text- , _otherSectionHeaders :: M.HashMap T.Text GodotValue- , _otherSectionEntries :: M.HashMap T.Text GodotValue- }- deriving (Show,Generic)---- | `tscn` file descriptor.-data TscnDescriptor =- TscnDescriptor- { _tscnDescriptorLoadSteps :: Int- , _tscnDescriptorFormat :: Int- }- deriving (Show,Generic)+-- | Parser for an ext_resource section.+extResourceP :: Parser ExtResource+extResourceP =+ headeredP+ "ext_resource"+ $ MkExtResource+ <$> jh @"GdString" "path"+ <*> jh @"GdString" "type"+ <*> jh @"GdInt" "id" --- | Parsed `tscn` file.-data TscnParsed =- TscnParsed- { _tscnParsedDescriptor :: TscnDescriptor- , _tscnParsedSections :: [GodotSection]+data SubResource = MkSubResource+ { type' :: T.Text+ , id' :: Int+ , headers :: KvAnn+ , entries :: KvAnn }- deriving (Show,Generic)+ deriving (Show, Generic) --- | `gdns` file descriptor.-data GdnsDescriptor =- GdnsDescriptor- { _gdnsDescriptorTy :: T.Text- , _gdnsDescriptorLoadSteps :: Int- , _gdnsDescriptorFormat :: Int- }- deriving (Show,Generic)+-- | Parser for a sub_resource section.+subResourceP :: Parser SubResource+subResourceP =+ headeredP+ "sub_resource"+ $ MkSubResource+ <$> jh @"GdString" "type"+ <*> jh @"GdInt" "id" --- | Parsed `gdns` file.-data GdnsParsed =- GdnsParsed- { _gdnsParsedDescriptor :: GdnsDescriptor- , _gdnsParsedSections :: [GodotSection]+data Node = MkNode+ { type' :: Maybe T.Text+ , name :: T.Text+ , parent :: Maybe T.Text+ , instance' :: Maybe Int+ , instancePlaceholder :: Maybe T.Text+ , owner :: Maybe T.Text+ , index :: Maybe Int+ , groups :: Maybe [T.Text]+ , headers :: KvAnn+ , entries :: KvAnn }- deriving (Show,Generic)+ deriving (Show, Generic) --- | An unknown file descriptor.-data OtherDescriptor =- OtherDescriptor- { _otherDescriptorHeaderName :: T.Text- , _otherDescriptorHeaders :: M.HashMap T.Text GodotValue- }- deriving (Show,Generic)+-- | Parser for a node section.+nodeP :: Parser Node+nodeP =+ headeredP+ "node"+ $ MkNode+ <$> jh' @"GdString" "type"+ <*> jh @"GdString" "name"+ <*> jh' @"GdString" "parent"+ <*> (jh' @"GdCstr" "instance" <&> (^? (_Just . _2 . ix 0 . _Ctor @"GdInt")))+ <*> jh' @"GdString" "instance_placeholder"+ <*> jh' @"GdString" "owner"+ <*> jh' @"GdInt" "index"+ <*> ( jh' @"GdArr" "groups"+ & over+ ( mapped+ . _Just+ . mapped+ )+ (fromJust . preview (_Ctor @"GdString"))+ ) --- | An unknown file parsing result.-data OtherParsed =- OtherParsed- { _otherParsedDescriptor :: OtherDescriptor- , _otherParsedSections :: [GodotSection]+data Connection = MkConnection+ { signal :: T.Text+ , from :: T.Text+ , to :: T.Text+ , method :: T.Text+ , headers :: KvAnn+ , entries :: KvAnn }- deriving (Show,Generic)---- | Parsed godot resource file.-data GodotParsed- = Tscn TscnParsed- | Gdns GdnsParsed- | Other OtherParsed- deriving (Show,Generic)--tscnHeaderKVP :: Parser (T.Text, GodotValue)-tscnHeaderKVP = liftA2 (,) (P.takeWhileP Nothing (/= '=')) (P.char '=' *> godotValueP)+ deriving (Show, Generic) -headerKvs :: Parser (M.HashMap T.Text GodotValue)-headerKvs = M.fromList <$> tscnHeaderKVP `P.sepBy` P.char ' '+-- | Parser for a connection section.+connectionP :: Parser Connection+connectionP =+ headeredP+ "connection"+ $ MkConnection+ <$> jh @"GdString" "signal"+ <*> jh @"GdString" "from"+ <*> jh @"GdString" "to"+ <*> jh @"GdString" "method" -bodyAndKvs :: Parser (T.Text, M.HashMap T.Text GodotValue, M.HashMap T.Text GodotValue)-bodyAndKvs = do- headerName <- P.char '[' *> P.takeWhile1P Nothing (/= ' ') <* P.char ' '- headerKvs' <- headerKvs- P.char ']'- P.space- let tscnBodyP = do- let parseKV =- liftA2 (,) (P.takeWhileP Nothing (/= ' '))- (P.string " = " *> godotValueP <* P.newline)- M.fromList <$> P.manyTill parseKV (P.try (P.newline $> ()) <|> P.try P.eof)- emptyBodyP = pure M.empty- body <- P.try tscnBodyP <|> P.try emptyBodyP- (headerName, headerKvs', body) <$ P.space+data Resource = MkResource+ { name :: Maybe T.Text+ , className :: Maybe T.Text+ , library :: Maybe (T.Text, [GdValue])+ }+ deriving (Show, Generic) --- | 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 -> a)- -> Parser a-headerWrapper targetSect p = do- (headerName, headerKvs', bodyKvs) <- bodyAndKvs- unless (headerName == targetSect) (fail "mismatched expected header")- pure $ p headerKvs' bodyKvs+-- | Parser for a resource section.+resourceP :: Parser Resource+resourceP =+ headeredP+ "resource"+ $ do+ signal' <- jb' @"GdString" "signal"+ from' <- jb' @"GdString" "from"+ to' <- jb' @"GdCstr" "to"+ pure \_ _ -> MkResource signal' from' to' --- | Parse a `[sub_resource]` section.-tscnSubResourceP :: Parser SubResource-tscnSubResourceP =- headerWrapper "sub_resource"- (\kvs bodyKvs -> SubResource (unGodotString' "type" kvs) (unGodotInt' "id" kvs)- (collectRest ["type", "id"] kvs) bodyKvs)+data GdSection+ = ExtResourceSc ExtResource+ | SubResourceSc SubResource+ | ConnectionSc Connection+ | ResourceSc Resource+ | NodeSc Node+ | OtherSc+ { header :: T.Text+ , headers :: KvAnn+ , entries :: KvAnn+ }+ deriving (Show, Generic) --- | Parse an `[ext_resource]` section.-tscnExtResourceP :: Parser ExtResource-tscnExtResourceP =- headerWrapper "ext_resource"- (\kvs bodyKvs -> ExtResource (unGodotString' "path" kvs)- (unGodotString' "type" kvs) (unGodotInt' "id" kvs)- (collectRest ["path", "type", "id"] kvs) bodyKvs)+-- | Parser for an unknown section.+otherP :: Parser GdSection+otherP = do+ (headerName', headerKvs', bodyKvs) <- bodyHeaderP+ pure $ OtherSc headerName' headerKvs' bodyKvs --- | Parse a `[node]` section.-tscnNodeP :: Parser Node-tscnNodeP =- headerWrapper "node"- (\kvs bodyKvs -> Node (unGodotString "type" kvs) (unGodotString' "name" kvs)- (unGodotString "parent" kvs)- ((\(GodotInt i) -> i) . head . snd <$> unGodotConstructor "instance" kvs)- (unGodotString "instance_placeholder" kvs) (unGodotString "owner" kvs)- (unGodotInt "index" kvs) (map (\(GodotString i) -> i) <$> unGodotArr "groups" kvs)- (collectRest- [ "path"- , "type"- , "parent"- , "name"- , "instance"- , "instance_placeholder"- , "owner"- , "index"- , "groups"] kvs) bodyKvs)+data TscnParsed = MkTscnParsed+ { loadSteps :: Int+ , format :: Int+ , sections :: [GdSection]+ }+ deriving (Show, Generic) --- | Parse a `[connection]` section.-tscnConnectionP :: Parser Connection-tscnConnectionP =- headerWrapper "connection"- (\kvs bodyKvs -> Connection (unGodotString' "signal" kvs)- (unGodotString' "from" kvs) (unGodotString' "to" kvs) (unGodotString' "method" kvs)- (collectRest ["signal", "from", "to", "method"] kvs) bodyKvs)+-- | Parser for a `tscn` file.+tscnP :: Parser TscnParsed+tscnP = do+ kvs <- P.string "[gd_scene " *> headerKvsP <* P.char ']' <* P.space+ let loadSteps' = jq @"GdInt" "load_steps" fromJust kvs+ format' = jq @"GdInt" "format" fromJust kvs+ sections' <- P.manyTill sectionP P.eof+ pure $ MkTscnParsed loadSteps' format' sections'+ where+ sectionP =+ P.choice $+ map+ P.try+ [ ConnectionSc <$> connectionP+ , ExtResourceSc <$> extResourceP+ , SubResourceSc <$> subResourceP+ , NodeSc <$> nodeP+ ] --- | Parse an unspecified section.-otherP :: Parser GodotSection-otherP = do- (headerName, headerKvs', bodyKvs) <- bodyAndKvs- pure $ OtherSection headerName headerKvs' bodyKvs+data GdExtensionParsed = MkGdExtensionParsed+ { entrySymbol :: T.Text+ , libraries :: HM.HashMap T.Text T.Text+ }+ deriving (Show, Generic) --- | Parse a `tscn` file.-tscnParser :: Parser TscnParsed-tscnParser = do- kvs <- P.string "[gd_scene " *> headerKvs <* P.char ']' <* P.space- let loadSteps = unGodotInt' "load_steps" kvs- format = unGodotInt' "format" kvs- sectionP =- P.choice- (map P.try- [ConnectionSection <$> tscnConnectionP, ExtResourceSection <$> tscnExtResourceP, SubResourceSection <$> tscnSubResourceP, NodeSection <$> tscnNodeP, otherP])- sections <- P.manyTill sectionP P.eof- pure $ TscnParsed (TscnDescriptor loadSteps format) sections+-- | Parser for a `gdextension` file.+gdExtensionP :: Parser GdExtensionParsed+gdExtensionP = do+ (_, _, HM.toList -> [("entry_symbol", GdString entryLib)]) <- bodyHeaderP+ (_, _, libs) <- bodyHeaderP+ let libs' = HM.map (fromJust . preview (_Ctor @"GdString")) libs+ pure $ MkGdExtensionParsed entryLib libs' --- | Parse a `[resource]` section.-resourceP :: Parser Resource-resourceP =- headerWrapper "resource"- (\_ bodyKvs -> Resource (unGodotString "resource_name" bodyKvs)- (unGodotString "class_name" bodyKvs) (unGodotConstructor "library" bodyKvs))+data UnknownParsed = MkUnknownParsed+ { headerName :: T.Text+ , headers :: KvAnn+ , sections :: [GdSection]+ }+ deriving (Show, Generic) --- | Parse a `gdns` file.-gdnsParser :: Parser GdnsParsed-gdnsParser = do- kvs <- P.string "[gd_resource " *> headerKvs <* P.char ']' <* P.space- let ty = unGodotString' "type" kvs- loadSteps = unGodotInt' "load_steps" kvs- format = unGodotInt' "format" kvs- sectionP = P.choice (map P.try [ExtResourceSection <$> tscnExtResourceP, ResourceSection <$> resourceP, otherP])- sections <- P.manyTill sectionP P.eof- pure $ GdnsParsed (GdnsDescriptor ty loadSteps format) sections+-- | Parser for an unknown file.+unknownP :: Parser UnknownParsed+unknownP = do+ headerName' <- P.char '[' *> P.takeWhile1P Nothing (/= ' ') <* P.char ' '+ headers' <- headerKvsP <* P.char ']' <* P.space+ sections' <- P.manyTill otherP P.eof+ pure $ MkUnknownParsed headerName' headers' sections' --- | Parse an unknown resource file.-otherParser :: Parser OtherParsed-otherParser = do- hName <- P.char '[' *> P.takeWhile1P Nothing (/= ' ') <* P.char ' '- hKvs <- headerKvs <* P.char ']' <* P.space- sections <- P.manyTill otherP P.eof- pure $ OtherParsed (OtherDescriptor hName hKvs) sections+data GdParsed+ = MkTscn TscnParsed+ | MkGdExtension GdExtensionParsed+ | MkUnknown UnknownParsed+ deriving (Show, Generic) --- | Parse some Godot resource file.-godotParser :: Parser GodotParsed-godotParser =- P.choice (map P.try [Tscn <$> tscnParser, Gdns <$> gdnsParser, Other <$> otherParser])+-- | Parse any Godot file.+parsedP :: Parser GdParsed+parsedP =+ P.choice $+ map+ P.try+ [ MkTscn <$> tscnP+ , MkGdExtension <$> gdExtensionP+ , MkUnknown <$> unknownP+ ]
− src/Godot/Parser/Resource/Lens.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}--module Godot.Parser.Resource.Lens where--import Control.Lens--import Godot.Parser.Resource--makeLenses ''GodotValue--makeLenses ''GodotSection--makeLenses ''TscnDescriptor--makeLenses ''TscnParsed--makeLenses ''GdnsDescriptor--makeLenses ''GdnsParsed--makeLenses ''OtherDescriptor--makeLenses ''OtherParsed--makeLenses ''GodotParsed--makeLenses ''ExtResource--makeLenses ''SubResource--makeLenses ''Node--makeLenses ''Connection--makeLenses ''Resource