anitomata-aseprite 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+88/−64 lines, 4 filesdep −attoparsecdep −string-interpolatePVP ok

version bump matches the API change (PVP)

Dependencies removed: attoparsec, string-interpolate

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• anitomata-aseprite.cabal +1/−3
• library/Anitomata/Aseprite/Preprocessor.hs +82/−58
• package.yaml +1/−3

@@ -1,3 +1,7 @@+## 0.1.1.0++* Drop dependencies on `attoparsec` and `string-interpolate`+ ## 0.1.0.0  * Initial release

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           anitomata-aseprite-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Code gen for Aseprite animations description:    @anitomata@ Haskell code generation for Aseprite animations. category:       Game@@ -41,13 +41,11 @@   ghc-options: -Weverything -Wno-missing-local-signatures -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specializations -Wno-all-missed-specializations -Wno-unsafe -Wno-safe -Wno-missing-safe-haskell-mode   build-depends:       aeson >=2.1.2.1 && <2.3-    , attoparsec >=0.14.4 && <0.15     , base >=4.17 && <4.20     , directory >=1.3.7.1 && <1.4     , filepath >=1.4.2.2 && <1.6     , module-munging ==0.1.*     , optparse-applicative >=0.17.1.0 && <0.19-    , string-interpolate >=0.3.2.1 && <0.4     , text >=2.0.2 && <2.2   default-language: GHC2021 

@@ -3,7 +3,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE StrictData #-} module Anitomata.Aseprite.Preprocessor   ( preprocessor@@ -16,18 +15,20 @@ import Control.Applicative ((<**>)) import Data.Aeson (FromJSON) import Data.Kind (Type)-import Data.String.Interpolate (__i, i) import GHC.Generics (Generic) import GHC.Records (HasField(getField)) import ModuleMunging   ( DeclBody(..), DeclName(..), ModuleDeclaration(..), ModuleFragment(..), ModuleImport(..)   , ModuleImportStyle(..), ModuleName(..), buildModule, displayModule   )+import Text.ParserCombinators.ReadP (ReadP)+import Text.Printf (printf)+import Type.Reflection (Typeable, typeRep)  import Control.Monad qualified as Monad import Data.Aeson qualified as Aeson import Data.Aeson.Types qualified as Aeson.Types-import Data.Attoparsec.Text qualified as Attoparsec+import Data.Char qualified as Char import Data.List qualified as List import Data.Maybe qualified as Maybe import Data.Text (Text)@@ -37,6 +38,8 @@ import System.Directory qualified as Directory import System.Exit qualified as Exit import System.FilePath qualified as FilePath+import Text.Read qualified as Read+import Text.ParserCombinators.ReadP qualified as ReadP  preprocessor :: IO () preprocessor = do@@ -52,7 +55,7 @@     let atlasPath = dir ++ FilePath.addExtension baseName ".json"     atlasExists <- Directory.doesFileExist atlasPath     Monad.unless atlasExists do-      Exit.die [i|aseprite2haskell: Aseprite atlas JSON does not exist at "#{atlasPath}"|]+      Exit.die $ printf "aseprite2haskell: Aseprite atlas JSON does not exist at %s" atlasPath     pure atlasPath   atlas <- Aeson.eitherDecodeFileStrict atlasPath >>= \case     Left decodeErr -> Exit.die $ "aseprite2haskell: failed to parse JSON - " <> show decodeErr@@ -78,7 +81,7 @@     [] -> []     (FrameInfo { filename }, frameIdx) : xs ->       let builderName = mkBuilderName filename-          sliceName = [i|#{builderName}_slice|] :: String+          sliceName = printf "%s_slice" builderName :: String           (dir, mTagRepeat) = dirAndRepeatFromTags filename        in [ ModuleFragment               { moduleFragmentImports =@@ -105,25 +108,24 @@                   [ ModuleDeclaration True (DeclName builderName) $ DeclBody                       case mTagRepeat of                         Nothing ->-                          [__i|-                            #{builderName} :: AnimBuilder-                            #{builderName} = #{builderFn dir} #{sliceName}-                          |]+                          List.intercalate "\n"+                            [ printf "%s :: AnimBuilder" builderName+                            , printf "%s = %s %s" builderName (builderFn dir) sliceName+                            ]                         Just (TagRepeat n) ->-                          [__i|-                            #{builderName} :: AnimBuilder-                            #{builderName} = repeatAnim (AnimRepeatCount #{n}) $ #{builderFn dir} #{sliceName}-                          |]-                  , ModuleDeclaration True (DeclName sliceName) $ DeclBody-                      [__i|-                        #{sliceName} :: AnimSlice-                        #{sliceName} =-                          AnimSlice-                            { animSliceDir = #{toAnimDir dir}-                            , animSliceFrameDurs = U.slice #{frameIdx} #{1 + length xs} #{durationsVecName}-                            , animSliceFrames = U.slice #{frameIdx} #{1 + length xs} #{framesVecName}-                            }-                      |]+                          List.intercalate "\n"+                            [ printf "%s :: AnimBuilder" builderName+                            , printf "%s = repeatAnim (AnimRepeatCount %d) $ %s %s" builderName n (builderFn dir) sliceName+                            ]+                  , ModuleDeclaration True (DeclName sliceName) $ DeclBody $ List.intercalate "\n"+                      [ printf "%s :: AnimSlice" sliceName+                      , printf "%s =" sliceName+                      ,        "  AnimSlice"+                      , printf "    { animSliceDir = %s" (toAnimDir dir)+                      , printf "    , animSliceFrameDurs = U.slice %d %d %s" frameIdx (1 + length xs) durationsVecName+                      , printf "    , animSliceFrames = U.slice %d %d %s" frameIdx (1 + length xs) framesVecName+                      ,        "    }"+                      ]                   ]               }           ]@@ -174,17 +176,17 @@           ]       , moduleFragmentDeclarations =           [ ModuleDeclaration False (DeclName framesVecName) $ DeclBody $ List.intercalate "\n"-              [ [i|#{framesVecName} :: U.Vector AnimFrame|]-              , [i|#{framesVecName} = U.fromListN #{length xs}|]-              , "  [ " <> List.intercalate "\n  , " (sourceRect . frame <$> xs)-              , "  ]"+              [ printf "%s :: U.Vector AnimFrame" framesVecName+              , printf "%s = U.fromListN %d" framesVecName $ length xs+              , printf "  [ %s" $ List.intercalate "\n  , " (sourceRect . frame <$> xs)+              ,        "  ]"               ]           ]       }   where   sourceRect :: Frame -> String   sourceRect Frame { x, y, w, h } =-    [i|AnimFrame { animFrameX = #{x}, animFrameY = #{y}, animFrameW = #{w}, animFrameH = #{h} }|]+    printf "AnimFrame { animFrameX = %d, animFrameY = %d, animFrameW = %d, animFrameH = %d }" x y w h  mkDurations :: [FrameInfo] -> ModuleFragment mkDurations = \case@@ -203,10 +205,10 @@           ]       , moduleFragmentDeclarations =           [ ModuleDeclaration False (DeclName durationsVecName) $ DeclBody $ List.intercalate "\n"-              [ [i|#{durationsVecName} :: U.Vector Double|]-              , [i|#{durationsVecName} = U.fromListN #{length xs}|]-              , "  [ " <> List.intercalate "\n  , " (show . toSeconds . duration <$> xs)-              , "  ]"+              [ printf "%s :: U.Vector Double" durationsVecName+              , printf "%s = U.fromListN %d" durationsVecName $ length xs+              , printf "  [ %s" $ List.intercalate "\n  , " (show . toSeconds . duration <$> xs)+              ,        "  ]"               ]           ]       }@@ -241,34 +243,33 @@ data TagNameField = TagNameField   { file :: Text   , tag :: Text-  }+  } deriving stock (Show)  instance FromJSON TagNameField where   parseJSON :: Aeson.Value -> Aeson.Types.Parser TagNameField-  parseJSON = Aeson.withText "FromJSON TagNameField" \t -> do-    case Attoparsec.parseOnly tagnameFieldParser t of-      Left err -> fail err-      Right x -> pure x+  parseJSON = parseJSONViaReadP tagnameFieldParser -tagnameFieldParser :: Attoparsec.Parser TagNameField+tagnameFieldParser :: ReadP TagNameField tagnameFieldParser = do-  file <- Attoparsec.takeWhile1 (/= '|')-  _ <- Attoparsec.char '|'-  tag <- Attoparsec.takeWhile1 (/= '|')+  file <- Text.pack <$> ReadP.munch1 (/= '|')+  _ <- ReadP.char '|'+  tag <- Text.pack <$> ReadP.munch1 (/= '|')+  ReadP.eof   pure TagNameField { file, tag }  type TagRepeat :: Type newtype TagRepeat = TagRepeat Int+  deriving stock (Show)  instance FromJSON TagRepeat where   parseJSON :: Aeson.Value -> Aeson.Types.Parser TagRepeat-  parseJSON = Aeson.withText "FromJSON TagRepeat" \t -> do-    case Attoparsec.parseOnly tagRepeatParser t of-      Left err -> fail err-      Right x -> pure x+  parseJSON = parseJSONViaReadP tagRepeatParser -tagRepeatParser :: Attoparsec.Parser TagRepeat-tagRepeatParser = TagRepeat <$> Attoparsec.decimal+tagRepeatParser :: ReadP TagRepeat+tagRepeatParser = do+  count <- intParser+  ReadP.eof+  pure $ TagRepeat count  type Direction :: Type data Direction@@ -311,22 +312,20 @@   } deriving stock (Show)  mkBuilderName :: FilenameField -> String-mkBuilderName FilenameField { file, tag } = [i|#{file}_#{tag}|]+mkBuilderName FilenameField { file, tag } = printf "%s_%s" file tag  instance FromJSON FilenameField where   parseJSON :: Aeson.Value -> Aeson.Types.Parser FilenameField-  parseJSON = Aeson.withText "FromJSON FilenameField" \t -> do-    case Attoparsec.parseOnly filenameFieldParser t of-      Left err -> fail err-      Right x -> pure x+  parseJSON = parseJSONViaReadP filenameFieldParser -filenameFieldParser :: Attoparsec.Parser FilenameField+filenameFieldParser :: ReadP FilenameField filenameFieldParser = do-  file <- Text.map sanitize <$> Attoparsec.takeWhile1 (/= '|')-  _ <- Attoparsec.char '|'-  tag <- Text.map sanitize <$> Attoparsec.takeWhile1 (/= '|')-  _ <- Attoparsec.char '|'-  frameIndex <- Attoparsec.decimal+  file <- Text.pack . map sanitize <$> ReadP.munch1 (/= '|')+  _ <- ReadP.char '|'+  tag <- Text.pack . map sanitize <$> ReadP.munch1 (/= '|')+  _ <- ReadP.char '|'+  frameIndex <- intParser+  ReadP.eof   pure FilenameField { file, tag, frameIndex }   where   sanitize :: Char -> Char@@ -376,3 +375,28 @@     { preprocessorOptsOrigSourceFile     , preprocessorOptsOutputFile     }++parseJSONViaReadP+  :: forall a+   . (Show a, Typeable a)+  => ReadP a+  -> Aeson.Types.Value+  -> Aeson.Types.Parser a+parseJSONViaReadP parser =+  Aeson.withText (printf "FromJSON %s" $ show $ typeRep @a) \case+    t -> case ReadP.readP_to_S parser s of+      [] -> fail $ printf "Parse failed on input: %s" s+      [(x, _)] -> pure x+      xs -> fail $ printf "Produced too many parses - input: %s, parses: %s" s $ show xs+      where+      s = Text.unpack t++intParser :: ReadP Int+intParser = do+  digitChars <- ReadP.many1 digitParser+  case Read.readMaybe digitChars of+    Nothing -> fail $ printf "Failed to read digits as Int: %s" digitChars+    Just x -> pure x++digitParser :: ReadP Char+digitParser = ReadP.satisfy Char.isDigit

@@ -1,5 +1,5 @@ name: anitomata-aseprite-version: 0.1.0.0+version: 0.1.1.0 homepage: https://sr.ht/~jship/anitomata/ git: https://git.sr.ht/~jship/anitomata/ license: MIT@@ -40,13 +40,11 @@ library:   dependencies:   - aeson >= 2.1.2.1 && <2.3-  - attoparsec >= 0.14.4 && <0.15   - base >= 4.17 && <4.20   - directory >= 1.3.7.1 && <1.4   - filepath >= 1.4.2.2 && <1.6   - module-munging >= 0.1 && <0.2   - optparse-applicative >= 0.17.1.0 && <0.19-  - string-interpolate >=0.3.2.1 && <0.4   - text >=2.0.2 && <2.2   source-dirs: library