dtab 1.1.1.1 → 1.2

raw patch · 7 files changed

+88/−49 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +6/−0
• LICENSE +1/−1
• dtab.cabal +1/−1
• src/Data/DTA/Base.hs +9/−3
• src/Data/DTA/Lex.x +38/−19
• src/Data/DTA/Parse.y +11/−7
• src/Data/DTA/PrettyPrint.hs +22/−18

@@ -1,3 +1,9 @@+1.2++* Rename Key constructor to Sym+* Fixed parsing/emitting of escape sequences in strings and symbols+* Add #autorun and #undef constructs found in later games+ 1.1.1.1  * Fix variables with certain characters being incorrectly parsed as symbols

@@ -1,4 +1,4 @@-Copyright 2012-2018 Michael Tolly
+Copyright 2012-2021 Michael Tolly
 
 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
 

@@ -1,5 +1,5 @@ name:               dtab-version:            1.1.1.1+version:            1.2 synopsis:           Harmonix (Guitar Hero, Rock Band) DTA/DTB metadata library description: 

@@ -43,7 +43,7 @@   = Int Int32   | Float Float   | Var B.ByteString-  | Key B.ByteString+  | Sym B.ByteString   | Unhandled   | IfDef B.ByteString   | Else@@ -56,6 +56,8 @@   | Include B.ByteString   | Merge B.ByteString   | IfNDef B.ByteString+  | Autorun+  | Undef B.ByteString   deriving (Eq, Ord, Show, Read, Typeable, Data)  --@@ -101,7 +103,7 @@   0x0  -> Int . fromIntegral <$> getWord32le   0x1  -> Float <$> getFloat32le   0x2  -> Var <$> getLenStr-  0x5  -> Key <$> getLenStr+  0x5  -> Sym <$> getLenStr   0x6  -> skip 4 >> return Unhandled   0x7  -> IfDef <$> getLenStr   0x8  -> skip 4 >> return Else@@ -114,6 +116,8 @@   0x21 -> Include <$> getLenStr   0x22 -> Merge <$> getLenStr   0x23 -> IfNDef <$> getLenStr+  0x24 -> skip 4 >> return Autorun+  0x25 -> Undef <$> getLenStr   _    -> fail $ "Unidentified DTB chunk with ID " ++ show cid  -- 4-byte chunk type ID, then at least 4 bytes of chunk data.@@ -122,7 +126,7 @@     Int i       -> putWord32le 0x0  >> putWord32le (fromIntegral i)     Float f     -> putWord32le 0x1  >> putFloat32le f     Var b       -> putWord32le 0x2  >> putLenStr b-    Key b       -> putWord32le 0x5  >> putLenStr b+    Sym b       -> putWord32le 0x5  >> putLenStr b     Unhandled   -> putWord32le 0x6  >> putWord32le 0     IfDef b     -> putWord32le 0x7  >> putLenStr b     Else        -> putWord32le 0x8  >> putWord32le 0@@ -135,6 +139,8 @@     Include b   -> putWord32le 0x21 >> putLenStr b     Merge b     -> putWord32le 0x22 >> putLenStr b     IfNDef b    -> putWord32le 0x23 >> putLenStr b+    Autorun     -> putWord32le 0x24 >> putWord32le 0+    Undef b     -> putWord32le 0x25 >> putLenStr b   get = binaryChunk DTAVersion1  -- | DTB string format: 4-byte length, then a string in latin-1.

@@ -25,6 +25,8 @@ \#include { \pn _ -> (pn, Include) } \#merge { \pn _ -> (pn, Merge) } \#ifndef { \pn _ -> (pn, IfNDef) }+\#autorun { \pn _ -> (pn, Autorun) }+\#undef { \pn _ -> (pn, Undef) }  -- Numbers. Longest match rule means N.N is float, not int. (\+ | \-)? $digit+ { \pn str -> (pn, Int $ read $ dropWhile (== '+') str) }@@ -38,15 +40,15 @@ -- Variable names. \$ (. # $white # [ \( \) \{ \} \[ \] ])+ { \pn str -> (pn, Var $ B8.pack $ tail str) } --- This reserved word needs to come before the general keyword rule.+-- This reserved word needs to come before the general symbol rule. "kDataUnhandled" { \pn _ -> (pn, Unhandled) } -- Quoted strings. \" ([^\"] | \n)* \" { \pn str -> (pn, String $ B8.pack $ readString str) }--- Quoted keywords.-' ([^'] | \\')* ' { \pn str -> (pn, Key $ B8.pack $ readKey str) }--- Raw keywords. Note: these can start with digits, like "3sand7s", as long as+-- Quoted symbols.+' ([^'] | \\')* ' { \pn str -> (pn, Sym $ B8.pack $ readQuotedSymbol str) }+-- Raw symbols. Note: these can start with digits, like "3sand7s", as long as -- they also have letters in them.-(. # $white # [ \( \) \{ \} \[ \] ])+ { \pn str -> (pn, Key $ B8.pack str) }+(. # $white # [ \( \) \{ \} \[ \] ])+ { \pn str -> (pn, Sym $ B8.pack str) }  -- Subtrees. \( { \pn _ -> (pn, LParen) }@@ -62,7 +64,7 @@   = Int Int32   | Float Float   | Var B8.ByteString-  | Key B8.ByteString+  | Sym B8.ByteString   | Unhandled   | IfDef   | Else@@ -78,23 +80,40 @@   | Include   | Merge   | IfNDef+  | Autorun+  | Undef   deriving (Eq, Ord, Show, Read) --- | Reads a single-quoted string, by converting it to a double-quoted one.-readKey :: String -> String-readKey = readString . go where-  go ('\'':xs) = '"' : go xs        -- string begin/end -> double-quote-  go ('"':xs) = '\\' : 'q' : go xs  -- double-quote gets encoded as \q-  go ('\\':x:xs) = '\\' : x : go xs -- any escaped char can remain escaped-  go (x:xs) = x : go xs             -- all other chars are unchanged-  go [] = []+mirrorTail :: [a] -> [a]+mirrorTail = go . drop 1 where+  go []       = [] -- shouldn't happen+  go [_]      = []+  go (x : xs) = x : go xs --- | Reads the special format for double-quoted strings.+{-+Escape sequences differ slightly in different games + other software like Magma.+To support encoding any character, we implement the following:+  \q means double quote inside double quotes, or single quote inside single quotes+  \n means newline in either double or single quotes+  \\ means literal backslash+Backslash not followed by backslash n or q also becomes a literal backslash.+-}++readQuotedSymbol :: String -> String+readQuotedSymbol = go . mirrorTail where+  go ('\\' : 'n'  : rest) = '\n' : go rest+  go ('\\' : 'q'  : rest) = '\'' : go rest+  go ('\\' : '\\' : rest) = '\\' : go rest+  go ""                   = ""+  go (c : rest)           = c : go rest+ readString :: String -> String-readString = read . go where-  go ('\\' : 'q' : rest) = '\\' : '"' : go rest-  go ""                  = ""-  go (c : rest)          = c : go rest+readString = go . mirrorTail where+  go ('\\' : 'n'  : rest) = '\n' : go rest+  go ('\\' : 'q'  : rest) = '"'  : go rest+  go ('\\' : '\\' : rest) = '\\' : go rest+  go ""                   = ""+  go (c : rest)           = c : go rest  scan :: String -> [(AlexPosn, Token)] scan = alexScanTokens

@@ -14,7 +14,7 @@   int { (_, L.Int $$) }   float { (_, L.Float $$) }   var { (_, L.Var $$) }-  key { (_, L.Key $$) }+  sym { (_, L.Sym $$) }   unhandled { (_, L.Unhandled) }   ifdef { (_, L.IfDef) }   else { (_, L.Else) }@@ -30,6 +30,8 @@   include { (_, L.Include) }   merge { (_, L.Merge) }   ifndef { (_, L.IfNDef) }+  autorun { (_, L.Autorun) }+  undef { (_, L.Undef) }  %% @@ -43,19 +45,21 @@ Chunk : int { Int $1 }       | float { Float $1 }       | var { Var $1 }-      | key { Key $1 }+      | sym { Sym $1 }       | unhandled { Unhandled }-      | ifdef key { IfDef $2 }+      | ifdef sym { IfDef $2 }       | else { Else }       | endif { EndIf }       | '(' Tree ')' { Parens $2 }       | '{' Tree '}' { Braces $2 }       | string { String $1 }       | '[' Tree ']' { Brackets $2 }-      | define key { Define $2 }-      | include key { Include $2 }-      | merge key { Merge $2 }-      | ifndef key { IfNDef $2 }+      | define sym { Define $2 }+      | include sym { Include $2 }+      | merge sym { Merge $2 }+      | ifndef sym { IfNDef $2 }+      | autorun { Autorun }+      | undef sym { Undef $2 }  { 

@@ -12,25 +12,31 @@   Int i -> PP.text $ show i   Float f -> PP.text $ show f   Var t -> PP.hcat [PP.char '$', ppText t]-  Key t -> ppKey $ B8.unpack t+  Sym t -> PP.text $ ppSym $ B8.unpack t   Unhandled -> PP.text "kDataUnhandled"   IfDef t -> PP.hsep [PP.text "#ifdef", ppText t]   Else -> PP.text "#else"   EndIf -> PP.text "#endif"   Parens tr -> PP.parens $ ppTree tr   Braces tr -> PP.braces $ ppTree tr-  String t -> PP.text $ let-    f '"'  = "\\q"-    f '\n' = "\\n"-    f ch   = [ch]-    in "\"" ++ concatMap f (B8.unpack t) ++ "\""+  String t -> PP.text $ doubleQuotedString $ B8.unpack t   Brackets tr -> PP.brackets $ ppTree tr   Define t -> PP.hsep [PP.text "#define", ppText t]   Include t -> PP.hsep [PP.text "#include", ppText t]   Merge t -> PP.hsep [PP.text "#merge", ppText t]   IfNDef t -> PP.hsep [PP.text "#ifndef", ppText t]+  Autorun -> PP.text "#autorun"+  Undef t -> PP.hsep [PP.text "#undef", ppText t]   where ppText = PP.text . B8.unpack +doubleQuotedString :: String -> String+doubleQuotedString t = let+  f '"'  = "\\q"+  f '\n' = "\\n"+  f '\\' = "\\\\"+  f ch   = [ch]+  in "\"" ++ concatMap f t ++ "\""+ -- | Automatically chooses between horizontal and vertical arrangements, -- depending on what kind of chunks are in the tree. ppTree :: Tree -> PP.Doc@@ -41,22 +47,20 @@           Int _     -> True           Float _   -> True           Var _     -> True-          Key _     -> True+          Sym _     -> True           Unhandled -> True           _         -> False --- | Produces a raw keyword or single-quoted string literal.-ppKey :: String -> PP.Doc-ppKey s-  | all (\c -> isAlphaNum c || elem c "_/.-=#<>&!") s && not (null s) = PP.text s+-- | Produces a raw symbol or single-quoted symbol literal.+ppSym :: String -> String+ppSym s+  | all (\c -> isAlphaNum c || elem c "_/.-=#<>&!") s && not (null s) = s   | otherwise = let-    -- simply convert a double-quoted string to single-quoted string-    f ""          = ""-    f ('"':xs)    = '\'' : f xs-    f ('\'':xs)   = '\\' : '\'' : f xs-    f ('\\':x:xs) = '\\' : x : f xs-    f (x:xs)      = x : f xs-    in PP.text $ f $ show s+    f '\'' = "\\q"+    f '\n' = "\\n"+    f '\\' = "\\\\"+    f ch   = [ch]+    in "'" <> concatMap f s <> "'"  ppDTA :: DTA -> PP.Doc ppDTA = PP.vcat . map ppChunk . treeChunks . topTree