diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 0.1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2024 Jason Shipman + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,130 @@ +# [anitomata-aseprite][] + +[![Version badge][]][version] + +## Synopsis + +`anitomata-aseprite` provides a preprocessor - `aseprite2haskell` - that +converts an Aseprite texture atlas JSON file into `anitomata` Haskell code. + +## Usage + +Imagine this fragment of directory structure for a game: + +``` +my-game +├── my-game.cabal +└── library + └── MyGame + └── Codegen + ├── Atlas.hs + └── Atlas.json +``` + +`Atlas.json` contains the JSON texture atlas exported using the Aseprite CLI. +`Atlas.hs` contains just this line: + +```haskell +{-# OPTIONS_GHC -F -pgmF aseprite2haskell #-} +``` + +This makes GHC invoke the `aseprite2haskell` preprocessor so that the +`MyGame.Codegen.Atlas` module will contain `AnimSlice` and `AnimBuilder` values +for all tags in the Aseprite texture atlas JSON. You will have one `AnimSlice` +per each Aseprite-tagged sequence of frames and one `AnimBuilder` wrapping that +`AnimSlice`. The generated code will look something like this: + +```haskell +-- Auto-generated - do not manually modify! +{-# LANGUAGE ImportQualifiedPost #-} +module Atlas where + +import Prelude +import Anitomata +import Data.Vector.Unboxed qualified as U + +owlet_walk :: AnimBuilder +owlet_walk = fromAnimSlice owlet_walk_slice + +owlet_walk_slice :: AnimSlice +owlet_walk_slice = + AnimSlice + { animSliceDir = AnimDirForward + , animSliceFrameDurs = U.slice 0 6 durations + , animSliceFrames = U.slice 0 6 frames + } + +owlet_run :: AnimBuilder +owlet_run = fromAnimSlice owlet_run_slice + +owlet_run_slice :: AnimSlice +owlet_run_slice = + AnimSlice + { animSliceDir = AnimDirForward + , animSliceFrameDurs = U.slice 6 6 durations + , animSliceFrames = U.slice 6 6 frames + } + +-- ... more builders and slices ... + +frames :: U.Vector AnimFrame +frames = -- ... vector of frames ... + +durations :: U.Vector Double +durations = -- ... vector of durations ... +``` + +Be sure to include your texture atlas JSON file in your package description's +`extra-source-files`. Note that if you rewrite your JSON file via re-exporting +from the Aseprite CLI (or just change the JSON file in general), you might need +to clean your game project for the updates to be picked up in your game. + +## Texture atlas format + +Currently, the preprocessor is not very flexible in regards to the JSON format +exported out of Aseprite. You **must** export your texture atlas using these +flags at a minimum: + +``` +path/to/aseprite \ + --batch \ + --list-tags \ + --filename-format '{title}|{tag}|{frame}' \ + --tagname-format '{title}|{tag}' \ + --sheet-pack \ + --format 'json-array' \ + --sheet "path/to/atlas.png" \ + --data "path/to/Atlas.json" \ + path/to/spritesheets/*.aseprite +``` + +`--list-tags`, `--filename-format`, `--tagname-format`, and `--format` are +critical. If you do not use these flags as shown above, `aseprite2haskell` will +not be able to parse your JSON. + +Also note that you **must** tag every frame in your Aseprite file. The tags map +to `AnimSlice` values in `anitomata`, so be sure to tag every minimal sequence +of frames comprising a logical chunk of animation (e.g. the frames for a "walk" +animation could have a tag named "walk"). This restriction may be lifted in the +future, but for now, all frames must be tagged. Tagging in Aseprite is also how +you control the `AnimDirection` of your `AnimSlice` values and the repeat count +of your `AnimBuilder` values. + +Here's an example of a spritesheet appropriately tagged for use with +`aseprite2haskell`: + +![Aseprite tags](./images/aseprite-tags.png) + +## Goals + +Defining animation slices is tedious and error prone. The main goal of +`anitomata-aseprite` is to automate away that pain. Currently, only the +preprocessor is provided. This is great for rapidly integrating animations into +a game, but some games may require dynamic loading of animations rather than +using generated code. `anitomata-aseprite` has a secondary goal of providing an +`aeson` parser to read animations in at runtime, but this code hasn't been +written yet. If you need this functionality, please consider contributing! + +[anitomata-aseprite]: +[Version badge]: +[version]: diff --git a/anitomata-aseprite.cabal b/anitomata-aseprite.cabal new file mode 100644 --- /dev/null +++ b/anitomata-aseprite.cabal @@ -0,0 +1,93 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.36.0. +-- +-- see: https://github.com/sol/hpack + +name: anitomata-aseprite +version: 0.1.0.0 +synopsis: Code gen for Aseprite animations +description: @anitomata@ Haskell code generation for Aseprite animations. +category: Game +homepage: https://sr.ht/~jship/anitomata/ +author: Jason Shipman +maintainer: Jason Shipman +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + CHANGELOG.md + LICENSE + package.yaml + README.md + images/aseprite-tags.png + +source-repository head + type: git + location: https://git.sr.ht/~jship/anitomata/ + +library + exposed-modules: + Anitomata.Aseprite + Anitomata.Aseprite.Preprocessor + other-modules: + Paths_anitomata_aseprite + hs-source-dirs: + library + default-extensions: + BlockArguments + DerivingVia + LambdaCase + 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 + +executable aseprite2haskell + main-is: Main.hs + other-modules: + Paths_anitomata_aseprite + hs-source-dirs: + executables/aseprite2haskell + default-extensions: + BlockArguments + DerivingVia + LambdaCase + 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 -rtsopts -threaded -with-rtsopts "-N" + build-depends: + anitomata-aseprite + , base + default-language: GHC2021 + +test-suite anitomata-aseprite-test-suite + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + Test.Anitomata.Aseprite.PreprocessorSpec + Paths_anitomata_aseprite + hs-source-dirs: + test-suite + default-extensions: + BlockArguments + DerivingVia + LambdaCase + 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 -rtsopts -threaded -with-rtsopts "-N" + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + anitomata-aseprite + , base + , file-embed + , hspec + , hspec-golden + , template-haskell + , temporary + default-language: GHC2021 diff --git a/executables/aseprite2haskell/Main.hs b/executables/aseprite2haskell/Main.hs new file mode 100644 --- /dev/null +++ b/executables/aseprite2haskell/Main.hs @@ -0,0 +1,9 @@ +module Main + ( main + ) where + +import Anitomata.Aseprite qualified +import Prelude + +main :: IO () +main = Anitomata.Aseprite.preprocessor diff --git a/images/aseprite-tags.png b/images/aseprite-tags.png new file mode 100644 Binary files /dev/null and b/images/aseprite-tags.png differ diff --git a/library/Anitomata/Aseprite.hs b/library/Anitomata/Aseprite.hs new file mode 100644 --- /dev/null +++ b/library/Anitomata/Aseprite.hs @@ -0,0 +1,6 @@ +module Anitomata.Aseprite + ( module Anitomata.Aseprite.Preprocessor + ) where + +import Anitomata.Aseprite.Preprocessor +import Prelude () diff --git a/library/Anitomata/Aseprite/Preprocessor.hs b/library/Anitomata/Aseprite/Preprocessor.hs new file mode 100644 --- /dev/null +++ b/library/Anitomata/Aseprite/Preprocessor.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StrictData #-} +module Anitomata.Aseprite.Preprocessor + ( preprocessor + , preprocessorWith + , PreprocessorOpts(..) + ) where + +import Prelude + +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 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.List qualified as List +import Data.Maybe qualified as Maybe +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import Options.Applicative qualified as Opt +import System.Directory qualified as Directory +import System.Exit qualified as Exit +import System.FilePath qualified as FilePath + +preprocessor :: IO () +preprocessor = do + opts <- Opt.execParser optsParser + preprocessorWith opts + +preprocessorWith :: PreprocessorOpts -> IO () +preprocessorWith opts = do + sourceFile' <- Directory.makeRelativeToCurrentDirectory sourceFile + atlasPath <- do + let dir = FilePath.dropFileName sourceFile' + let baseName = FilePath.takeBaseName sourceFile' + 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}"|] + pure atlasPath + atlas <- Aeson.eitherDecodeFileStrict atlasPath >>= \case + Left decodeErr -> Exit.die $ "aseprite2haskell: failed to parse JSON - " <> show decodeErr + Right x -> pure x + Text.IO.writeFile outputFile $ Text.pack $ displayModule $ buildModule (ModuleNameFromFilePath sourceFile') $ mconcat + [ mkBuildersAndSlices atlas + , mkFrames $ frames atlas + , mkDurations $ frames atlas + ] + where + PreprocessorOpts + { preprocessorOptsOrigSourceFile = sourceFile + , preprocessorOptsOutputFile = outputFile + } = opts + +mkBuildersAndSlices :: Atlas -> ModuleFragment +mkBuildersAndSlices Atlas { frames, meta = Meta { frameTags = tags } } + | null frames = mempty + | otherwise = mconcat $ flattenFrameInfo $ List.groupBy groupFrameInfo $ zip frames [0 :: Int ..] + where + flattenFrameInfo :: [[(FrameInfo, Int)]] -> [ModuleFragment] + flattenFrameInfo = foldMap \case + [] -> [] + (FrameInfo { filename }, frameIdx) : xs -> + let builderName = mkBuilderName filename + sliceName = [i|#{builderName}_slice|] :: String + (dir, mTagRepeat) = dirAndRepeatFromTags filename + in [ ModuleFragment + { moduleFragmentImports = + [ ModuleImport + { moduleImportName = "Prelude" + , moduleImportStyle = ModuleImportStyleOpen + } + , ModuleImport + { moduleImportName = "Anitomata" + , moduleImportStyle = ModuleImportStyleExplicit + $ "AnimBuilder" + : "AnimDir(..)" + : "AnimSlice" + : "AnimSlice_(..)" + : builderFn dir + : [x | Maybe.isJust mTagRepeat, x <- ["AnimRepeat(..)", "repeatAnim"]] + } + , ModuleImport + { moduleImportName = "Data.Vector.Unboxed" + , moduleImportStyle = ModuleImportStyleQualified $ Just "U" + } + ] + , moduleFragmentDeclarations = + [ ModuleDeclaration True (DeclName builderName) $ DeclBody + case mTagRepeat of + Nothing -> + [__i| + #{builderName} :: AnimBuilder + #{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} + } + |] + ] + } + ] + + groupFrameInfo :: (FrameInfo, Int) -> (FrameInfo, Int) -> Bool + groupFrameInfo (FrameInfo { filename = x }, _) (FrameInfo { filename = y }, _) = + getField @"file" x == getField @"file" y && getField @"tag" x == getField @"tag" y + + dirAndRepeatFromTags :: FilenameField -> (Direction, Maybe TagRepeat) + dirAndRepeatFromTags FilenameField { file, tag } = + maybe (Forward, Nothing) ((,) <$> direction <*> getField @"repeat") + $ flip List.find tags \case + FrameTag { name = nameField } -> + file == getField @"file" nameField && tag == getField @"tag" nameField + + toAnimDir :: Direction -> String + toAnimDir = \case + Forward -> "AnimDirForward" + Reverse -> "AnimDirBackward" + Pingpong -> "AnimDirForward" + PingpongReverse -> "AnimDirBackward" + + builderFn :: Direction -> String + builderFn = \case + Forward -> "fromAnimSlice" + Reverse -> "fromAnimSlice" + Pingpong -> "pingpongAnimSlice" + PingpongReverse -> "pingpongAnimSlice" + +mkFrames :: [FrameInfo] -> ModuleFragment +mkFrames = \case + [] -> mempty + xs -> + ModuleFragment + { moduleFragmentImports = + [ ModuleImport + { moduleImportName = "Prelude" + , moduleImportStyle = ModuleImportStyleOpen + } + , ModuleImport + { moduleImportName = "Data.Vector.Unboxed" + , moduleImportStyle = ModuleImportStyleQualified $ Just "U" + } + , ModuleImport + { moduleImportName = "Anitomata" + , moduleImportStyle = ModuleImportStyleExplicit ["AnimFrame", "AnimFrame_(..)"] + } + ] + , 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) + , " ]" + ] + ] + } + where + sourceRect :: Frame -> String + sourceRect Frame { x, y, w, h } = + [i|AnimFrame { animFrameX = #{x}, animFrameY = #{y}, animFrameW = #{w}, animFrameH = #{h} }|] + +mkDurations :: [FrameInfo] -> ModuleFragment +mkDurations = \case + [] -> mempty + xs -> + ModuleFragment + { moduleFragmentImports = + [ ModuleImport + { moduleImportName = "Prelude" + , moduleImportStyle = ModuleImportStyleOpen + } + , ModuleImport + { moduleImportName = "Data.Vector.Unboxed" + , moduleImportStyle = ModuleImportStyleQualified $ Just "U" + } + ] + , 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) + , " ]" + ] + ] + } + where + toSeconds :: Int -> Double + toSeconds ms = fromIntegral ms / 1000 + +type Atlas :: Type +data Atlas = Atlas + { frames :: [FrameInfo] + , meta :: Meta + } deriving stock (Generic) + deriving anyclass (FromJSON) + +type Meta :: Type +newtype Meta = Meta + { frameTags :: [FrameTag] + } deriving stock (Generic) + deriving anyclass (FromJSON) + +type FrameTag :: Type +data FrameTag = FrameTag + { name :: TagNameField + , from :: Int + , to :: Int + , direction :: Direction + , repeat :: Maybe TagRepeat + } deriving stock (Generic) + deriving anyclass (FromJSON) + +type TagNameField :: Type +data TagNameField = TagNameField + { file :: Text + , tag :: Text + } + +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 + +tagnameFieldParser :: Attoparsec.Parser TagNameField +tagnameFieldParser = do + file <- Attoparsec.takeWhile1 (/= '|') + _ <- Attoparsec.char '|' + tag <- Attoparsec.takeWhile1 (/= '|') + pure TagNameField { file, tag } + +type TagRepeat :: Type +newtype TagRepeat = TagRepeat Int + +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 + +tagRepeatParser :: Attoparsec.Parser TagRepeat +tagRepeatParser = TagRepeat <$> Attoparsec.decimal + +type Direction :: Type +data Direction + = Forward + | Reverse + | Pingpong + | PingpongReverse + +instance FromJSON Direction where + parseJSON :: Aeson.Value -> Aeson.Types.Parser Direction + parseJSON = Aeson.withText "FromJSON Direction" \case + "forward" -> pure Forward + "reverse" -> pure Reverse + "pingpong" -> pure Pingpong + "pingpong_reverse" -> pure PingpongReverse + other -> fail $ "Invalid direction: " <> show other + +type FrameInfo :: Type +data FrameInfo = FrameInfo + { filename :: FilenameField + , frame :: Frame + , duration :: Int + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +framesVecName :: String +framesVecName = "frames" + +durationsVecName :: String +durationsVecName = "durations" + +type FilenameField :: Type +data FilenameField = FilenameField + { file :: Text + , tag :: Text + -- | This is the frame index in the specific .aseprite file, NOT the frame + -- index in the overall texture atlas frames. It is only parsed here for + -- debugging's sake to cross-reference individual .aseprite files. + , frameIndex :: Int + } deriving stock (Show) + +mkBuilderName :: FilenameField -> String +mkBuilderName FilenameField { file, tag } = [i|#{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 + +filenameFieldParser :: Attoparsec.Parser FilenameField +filenameFieldParser = do + file <- Text.map sanitize <$> Attoparsec.takeWhile1 (/= '|') + _ <- Attoparsec.char '|' + tag <- Text.map sanitize <$> Attoparsec.takeWhile1 (/= '|') + _ <- Attoparsec.char '|' + frameIndex <- Attoparsec.decimal + pure FilenameField { file, tag, frameIndex } + where + sanitize :: Char -> Char + sanitize = \case + '-' -> '_' + c -> c + +type Frame :: Type +data Frame = Frame + { x :: Int + , y :: Int + , w :: Int + , h :: Int + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +optsParser :: Opt.ParserInfo PreprocessorOpts +optsParser = Opt.info (preprocessorOptsParser <**> Opt.helper) $ mconcat + [ Opt.fullDesc + , Opt.progDesc "Convert an Aseprite texture atlas JSON into Haskell code" + , Opt.header "aseprite2haskell - Aseprite -> Haskell preprocessor" + ] + +type PreprocessorOpts :: Type +data PreprocessorOpts = PreprocessorOpts + { preprocessorOptsOrigSourceFile :: FilePath + , preprocessorOptsOutputFile :: FilePath + } deriving stock (Show) + +preprocessorOptsParser :: Opt.Parser PreprocessorOpts +preprocessorOptsParser = do + preprocessorOptsOrigSourceFile <- Opt.argument Opt.str $ mconcat + [ Opt.metavar "SOURCE" + , Opt.help "Original source filepath (passed by GHC)" + ] + -- It seems this positional argument only matters when multiple preprocessors + -- are stacked (e.g. CPP and this custom one). It is ignored here. + _ <- Opt.argument @String Opt.str $ mconcat + [ Opt.metavar "INPUT" + , Opt.help "Input filepath (passed by GHC)" + ] + preprocessorOptsOutputFile <- Opt.argument Opt.str $ mconcat + [ Opt.metavar "OUTPUT" + , Opt.help "Output filepath (passed by GHC)" + ] + pure PreprocessorOpts + { preprocessorOptsOrigSourceFile + , preprocessorOptsOutputFile + } diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,82 @@ +name: anitomata-aseprite +version: 0.1.0.0 +homepage: https://sr.ht/~jship/anitomata/ +git: https://git.sr.ht/~jship/anitomata/ +license: MIT +license-file: LICENSE +author: Jason Shipman +maintainer: Jason Shipman +synopsis: Code gen for Aseprite animations +description: | + @anitomata@ Haskell code generation for Aseprite animations. +category: Game + +extra-source-files: +- CHANGELOG.md +- LICENSE +- package.yaml +- README.md +- images/aseprite-tags.png + +language: GHC2021 + +default-extensions: +- BlockArguments +- DerivingVia +- LambdaCase + +ghc-options: +# Draws heavy inspiration from this list: https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3 +- -Weverything +- -Wno-missing-local-signatures # Warns if polymorphic local bindings do not have signatures +- -Wno-missing-exported-signatures # missing-exported-signatures turns off the more strict -Wmissing-signatures. See https://ghc.haskell.org/trac/ghc/ticket/14794#ticket +- -Wno-missing-import-lists # Requires explicit imports of _every_ function (e.g. ‘$’); too strict +- -Wno-missed-specializations # When GHC can’t specialize a polymorphic function +- -Wno-all-missed-specializations # See missed-specializations +- -Wno-unsafe # Don’t use Safe Haskell warnings +- -Wno-safe # Don’t use Safe Haskell warnings +- -Wno-missing-safe-haskell-mode # Don't warn if the Safe Haskell mode is unspecified + +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 + +tests: + anitomata-aseprite-test-suite: + source-dirs: test-suite + main: Driver.hs + build-tools: + - hspec-discover + dependencies: + - anitomata-aseprite + - base + - file-embed + - hspec + - hspec-golden + - template-haskell + - temporary + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts "-N" + +executables: + aseprite2haskell: + source-dirs: executables/aseprite2haskell + main: Main.hs + dependencies: + - anitomata-aseprite + - base + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts "-N" diff --git a/test-suite/Driver.hs b/test-suite/Driver.hs new file mode 100644 --- /dev/null +++ b/test-suite/Driver.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test-suite/Test/Anitomata/Aseprite/PreprocessorSpec.hs b/test-suite/Test/Anitomata/Aseprite/PreprocessorSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Test/Anitomata/Aseprite/PreprocessorSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TemplateHaskell #-} +module Test.Anitomata.Aseprite.PreprocessorSpec + ( spec + ) where + +import Prelude + +import Anitomata.Aseprite.Preprocessor (PreprocessorOpts(..), preprocessorWith) +import Data.FileEmbed (makeRelativeToProject) +import Language.Haskell.TH (Exp(LitE), Lit(StringL)) +import System.IO (hClose) +import System.IO.Temp (withSystemTempFile) +import Test.Hspec (Spec, describe, it, parallel) +import Test.Hspec.Golden (defaultGolden) + +atlasModule :: FilePath +atlasModule = $(LitE . StringL <$> makeRelativeToProject "test-suite/codegen/TestAtlas.hs") + +spec :: Spec +spec = parallel do + describe "Anitomata.Aseprite.Preprocessor" do + it "works" do + withSystemTempFile "aseprite2haskell" \outputFilePath outputHandle -> do + hClose outputHandle + preprocessorWith PreprocessorOpts + { preprocessorOptsOrigSourceFile = atlasModule + , preprocessorOptsOutputFile = outputFilePath + } + output <- readFile outputFilePath + pure $ defaultGolden "aseprite2haskell" output