diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.1.1.0 + +* Drop dependencies on `attoparsec` and `string-interpolate` + ## 0.1.0.0 * Initial release diff --git a/anitomata-aseprite.cabal b/anitomata-aseprite.cabal --- a/anitomata-aseprite.cabal +++ b/anitomata-aseprite.cabal @@ -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 diff --git a/library/Anitomata/Aseprite/Preprocessor.hs b/library/Anitomata/Aseprite/Preprocessor.hs --- a/library/Anitomata/Aseprite/Preprocessor.hs +++ b/library/Anitomata/Aseprite/Preprocessor.hs @@ -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 diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -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