{-# 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 :: IO ()
preprocessor = do
  PreprocessorOpts
opts <- ParserInfo PreprocessorOpts -> IO PreprocessorOpts
forall a. ParserInfo a -> IO a
Opt.execParser ParserInfo PreprocessorOpts
optsParser
  PreprocessorOpts -> IO ()
preprocessorWith PreprocessorOpts
opts

preprocessorWith :: PreprocessorOpts -> IO ()
preprocessorWith :: PreprocessorOpts -> IO ()
preprocessorWith PreprocessorOpts
opts = do
  FilePath
sourceFile' <- FilePath -> IO FilePath
Directory.makeRelativeToCurrentDirectory FilePath
sourceFile
  FilePath
atlasPath <- do
    let dir :: FilePath
dir = FilePath -> FilePath
FilePath.dropFileName FilePath
sourceFile'
    let baseName :: FilePath
baseName = FilePath -> FilePath
FilePath.takeBaseName FilePath
sourceFile'
    let atlasPath :: FilePath
atlasPath = FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
FilePath.addExtension FilePath
baseName FilePath
".json"
    Bool
atlasExists <- FilePath -> IO Bool
Directory.doesFileExist FilePath
atlasPath
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless Bool
atlasExists do
      FilePath -> IO ()
forall a. FilePath -> IO a
Exit.die [i|aseprite2haskell: Aseprite atlas JSON does not exist at "#{atlasPath}"|]
    pure FilePath
atlasPath
  Atlas
atlas <- FilePath -> IO (Either FilePath Atlas)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict FilePath
atlasPath IO (Either FilePath Atlas)
-> (Either FilePath Atlas -> IO Atlas) -> IO Atlas
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left FilePath
decodeErr -> FilePath -> IO Atlas
forall a. FilePath -> IO a
Exit.die (FilePath -> IO Atlas) -> FilePath -> IO Atlas
forall a b. (a -> b) -> a -> b
$ FilePath
"aseprite2haskell: failed to parse JSON - " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
decodeErr
    Right Atlas
x -> Atlas -> IO Atlas
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atlas
x
  FilePath -> Text -> IO ()
Text.IO.writeFile FilePath
outputFile (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Module -> FilePath
displayModule (Module -> FilePath) -> Module -> FilePath
forall a b. (a -> b) -> a -> b
$ ModuleName -> ModuleFragment -> Module
buildModule (FilePath -> ModuleName
ModuleNameFromFilePath FilePath
sourceFile') (ModuleFragment -> Module) -> ModuleFragment -> Module
forall a b. (a -> b) -> a -> b
$ [ModuleFragment] -> ModuleFragment
forall a. Monoid a => [a] -> a
mconcat
    [ Atlas -> ModuleFragment
mkBuildersAndSlices Atlas
atlas
    , [FrameInfo] -> ModuleFragment
mkFrames ([FrameInfo] -> ModuleFragment) -> [FrameInfo] -> ModuleFragment
forall a b. (a -> b) -> a -> b
$ Atlas -> [FrameInfo]
frames Atlas
atlas
    , [FrameInfo] -> ModuleFragment
mkDurations ([FrameInfo] -> ModuleFragment) -> [FrameInfo] -> ModuleFragment
forall a b. (a -> b) -> a -> b
$ Atlas -> [FrameInfo]
frames Atlas
atlas
    ]
  where
  PreprocessorOpts
    { $sel:preprocessorOptsOrigSourceFile:PreprocessorOpts :: PreprocessorOpts -> FilePath
preprocessorOptsOrigSourceFile = FilePath
sourceFile
    , $sel:preprocessorOptsOutputFile:PreprocessorOpts :: PreprocessorOpts -> FilePath
preprocessorOptsOutputFile = FilePath
outputFile
    } = PreprocessorOpts
opts

mkBuildersAndSlices :: Atlas -> ModuleFragment
mkBuildersAndSlices :: Atlas -> ModuleFragment
mkBuildersAndSlices Atlas { [FrameInfo]
$sel:frames:Atlas :: Atlas -> [FrameInfo]
frames :: [FrameInfo]
frames, $sel:meta:Atlas :: Atlas -> Meta
meta = Meta { $sel:frameTags:Meta :: Meta -> [FrameTag]
frameTags = [FrameTag]
tags } }
  | [FrameInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FrameInfo]
frames = ModuleFragment
forall a. Monoid a => a
mempty
  | Bool
otherwise = [ModuleFragment] -> ModuleFragment
forall a. Monoid a => [a] -> a
mconcat ([ModuleFragment] -> ModuleFragment)
-> [ModuleFragment] -> ModuleFragment
forall a b. (a -> b) -> a -> b
$ [[(FrameInfo, Int)]] -> [ModuleFragment]
flattenFrameInfo ([[(FrameInfo, Int)]] -> [ModuleFragment])
-> [[(FrameInfo, Int)]] -> [ModuleFragment]
forall a b. (a -> b) -> a -> b
$ ((FrameInfo, Int) -> (FrameInfo, Int) -> Bool)
-> [(FrameInfo, Int)] -> [[(FrameInfo, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (FrameInfo, Int) -> (FrameInfo, Int) -> Bool
groupFrameInfo ([(FrameInfo, Int)] -> [[(FrameInfo, Int)]])
-> [(FrameInfo, Int)] -> [[(FrameInfo, Int)]]
forall a b. (a -> b) -> a -> b
$ [FrameInfo] -> [Int] -> [(FrameInfo, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FrameInfo]
frames [Int
0 :: Int ..]
  where
  flattenFrameInfo :: [[(FrameInfo, Int)]] -> [ModuleFragment]
  flattenFrameInfo :: [[(FrameInfo, Int)]] -> [ModuleFragment]
flattenFrameInfo = ([(FrameInfo, Int)] -> [ModuleFragment])
-> [[(FrameInfo, Int)]] -> [ModuleFragment]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
    [] -> []
    (FrameInfo { FilenameField
filename :: FilenameField
$sel:filename:FrameInfo :: FrameInfo -> FilenameField
filename }, Int
frameIdx) : [(FrameInfo, Int)]
xs ->
      let builderName :: FilePath
builderName = FilenameField -> FilePath
mkBuilderName FilenameField
filename
          sliceName :: FilePath
sliceName = [i|#{builderName}_slice|] :: String
          (Direction
dir, Maybe TagRepeat
mTagRepeat) = FilenameField -> (Direction, Maybe TagRepeat)
dirAndRepeatFromTags FilenameField
filename
       in [ ModuleFragment
              { moduleFragmentImports :: [ModuleImport]
moduleFragmentImports =
                  [ ModuleImport
                      { moduleImportName :: FilePath
moduleImportName = FilePath
"Prelude"
                      , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = ModuleImportStyle
ModuleImportStyleOpen
                      }
                  , ModuleImport
                      { moduleImportName :: FilePath
moduleImportName = FilePath
"Anitomata"
                      , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = [FilePath] -> ModuleImportStyle
ModuleImportStyleExplicit
                          ([FilePath] -> ModuleImportStyle)
-> [FilePath] -> ModuleImportStyle
forall a b. (a -> b) -> a -> b
$ FilePath
"AnimBuilder"
                          FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
"AnimDir(..)"
                          FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
"AnimSlice"
                          FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
"AnimSlice_(..)"
                          FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Direction -> FilePath
builderFn Direction
dir
                          FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath
x | Maybe TagRepeat -> Bool
forall a. Maybe a -> Bool
Maybe.isJust Maybe TagRepeat
mTagRepeat, FilePath
x <- [FilePath
"AnimRepeat(..)", FilePath
"repeatAnim"]]
                      }
                  , ModuleImport
                      { moduleImportName :: FilePath
moduleImportName = FilePath
"Data.Vector.Unboxed"
                      , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = Maybe FilePath -> ModuleImportStyle
ModuleImportStyleQualified (Maybe FilePath -> ModuleImportStyle)
-> Maybe FilePath -> ModuleImportStyle
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"U"
                      }
                  ]
              , moduleFragmentDeclarations :: [ModuleDeclaration]
moduleFragmentDeclarations =
                  [ Bool -> DeclName -> DeclBody -> ModuleDeclaration
ModuleDeclaration Bool
True (FilePath -> DeclName
DeclName FilePath
builderName) (DeclBody -> ModuleDeclaration) -> DeclBody -> ModuleDeclaration
forall a b. (a -> b) -> a -> b
$ FilePath -> DeclBody
DeclBody
                      case Maybe TagRepeat
mTagRepeat of
                        Maybe TagRepeat
Nothing ->
                          [__i|
                            #{builderName} :: AnimBuilder
                            #{builderName} = #{builderFn dir} #{sliceName}
                          |]
                        Just (TagRepeat Int
n) ->
                          [__i|
                            #{builderName} :: AnimBuilder
                            #{builderName} = repeatAnim (AnimRepeatCount #{n}) $ #{builderFn dir} #{sliceName}
                          |]
                  , Bool -> DeclName -> DeclBody -> ModuleDeclaration
ModuleDeclaration Bool
True (FilePath -> DeclName
DeclName FilePath
sliceName) (DeclBody -> ModuleDeclaration) -> DeclBody -> ModuleDeclaration
forall a b. (a -> b) -> a -> b
$ FilePath -> DeclBody
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, Int) -> (FrameInfo, Int) -> Bool
groupFrameInfo (FrameInfo { $sel:filename:FrameInfo :: FrameInfo -> FilenameField
filename = FilenameField
x }, Int
_) (FrameInfo { $sel:filename:FrameInfo :: FrameInfo -> FilenameField
filename = FilenameField
y }, Int
_) =
    forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"file" FilenameField
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"file" FilenameField
y Bool -> Bool -> Bool
&& forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"tag" FilenameField
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"tag" FilenameField
y

  dirAndRepeatFromTags :: FilenameField -> (Direction, Maybe TagRepeat)
  dirAndRepeatFromTags :: FilenameField -> (Direction, Maybe TagRepeat)
dirAndRepeatFromTags FilenameField { Text
file :: Text
$sel:file:FilenameField :: FilenameField -> Text
file, Text
tag :: Text
$sel:tag:FilenameField :: FilenameField -> Text
tag } =
    (Direction, Maybe TagRepeat)
-> (FrameTag -> (Direction, Maybe TagRepeat))
-> Maybe FrameTag
-> (Direction, Maybe TagRepeat)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Direction
Forward, Maybe TagRepeat
forall a. Maybe a
Nothing) ((,) (Direction -> Maybe TagRepeat -> (Direction, Maybe TagRepeat))
-> (FrameTag -> Direction)
-> FrameTag
-> Maybe TagRepeat
-> (Direction, Maybe TagRepeat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FrameTag -> Direction
direction (FrameTag -> Maybe TagRepeat -> (Direction, Maybe TagRepeat))
-> (FrameTag -> Maybe TagRepeat)
-> FrameTag
-> (Direction, Maybe TagRepeat)
forall a b.
(FrameTag -> a -> b) -> (FrameTag -> a) -> FrameTag -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"repeat")
      (Maybe FrameTag -> (Direction, Maybe TagRepeat))
-> Maybe FrameTag -> (Direction, Maybe TagRepeat)
forall a b. (a -> b) -> a -> b
$ ((FrameTag -> Bool) -> [FrameTag] -> Maybe FrameTag)
-> [FrameTag] -> (FrameTag -> Bool) -> Maybe FrameTag
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FrameTag -> Bool) -> [FrameTag] -> Maybe FrameTag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find [FrameTag]
tags \case
          FrameTag { $sel:name:FrameTag :: FrameTag -> TagNameField
name = TagNameField
nameField } ->
            Text
file Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"file" TagNameField
nameField Bool -> Bool -> Bool
&& Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"tag" TagNameField
nameField

  toAnimDir :: Direction -> String
  toAnimDir :: Direction -> FilePath
toAnimDir = \case
    Direction
Forward -> FilePath
"AnimDirForward"
    Direction
Reverse -> FilePath
"AnimDirBackward"
    Direction
Pingpong -> FilePath
"AnimDirForward"
    Direction
PingpongReverse -> FilePath
"AnimDirBackward"

  builderFn :: Direction -> String
  builderFn :: Direction -> FilePath
builderFn = \case
    Direction
Forward -> FilePath
"fromAnimSlice"
    Direction
Reverse -> FilePath
"fromAnimSlice"
    Direction
Pingpong -> FilePath
"pingpongAnimSlice"
    Direction
PingpongReverse -> FilePath
"pingpongAnimSlice"

mkFrames :: [FrameInfo] -> ModuleFragment
mkFrames :: [FrameInfo] -> ModuleFragment
mkFrames = \case
  [] -> ModuleFragment
forall a. Monoid a => a
mempty
  [FrameInfo]
xs ->
    ModuleFragment
      { moduleFragmentImports :: [ModuleImport]
moduleFragmentImports =
          [ ModuleImport
              { moduleImportName :: FilePath
moduleImportName = FilePath
"Prelude"
              , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = ModuleImportStyle
ModuleImportStyleOpen
              }
          , ModuleImport
              { moduleImportName :: FilePath
moduleImportName = FilePath
"Data.Vector.Unboxed"
              , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = Maybe FilePath -> ModuleImportStyle
ModuleImportStyleQualified (Maybe FilePath -> ModuleImportStyle)
-> Maybe FilePath -> ModuleImportStyle
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"U"
              }
          , ModuleImport
              { moduleImportName :: FilePath
moduleImportName = FilePath
"Anitomata"
              , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = [FilePath] -> ModuleImportStyle
ModuleImportStyleExplicit [FilePath
"AnimFrame", FilePath
"AnimFrame_(..)"]
              }
          ]
      , moduleFragmentDeclarations :: [ModuleDeclaration]
moduleFragmentDeclarations =
          [ Bool -> DeclName -> DeclBody -> ModuleDeclaration
ModuleDeclaration Bool
False (FilePath -> DeclName
DeclName FilePath
framesVecName) (DeclBody -> ModuleDeclaration) -> DeclBody -> ModuleDeclaration
forall a b. (a -> b) -> a -> b
$ FilePath -> DeclBody
DeclBody (FilePath -> DeclBody) -> FilePath -> DeclBody
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n"
              [ [i|#{framesVecName} :: U.Vector AnimFrame|]
              , [i|#{framesVecName} = U.fromListN #{length xs}|]
              , FilePath
"  [ " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n  , " (Frame -> FilePath
sourceRect (Frame -> FilePath)
-> (FrameInfo -> Frame) -> FrameInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FrameInfo -> Frame
frame (FrameInfo -> FilePath) -> [FrameInfo] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FrameInfo]
xs)
              , FilePath
"  ]"
              ]
          ]
      }
  where
  sourceRect :: Frame -> String
  sourceRect :: Frame -> FilePath
sourceRect Frame { Int
x :: Int
$sel:x:Frame :: Frame -> Int
x, Int
y :: Int
$sel:y:Frame :: Frame -> Int
y, Int
w :: Int
$sel:w:Frame :: Frame -> Int
w, Int
h :: Int
$sel:h:Frame :: Frame -> Int
h } =
    [i|AnimFrame { animFrameX = #{x}, animFrameY = #{y}, animFrameW = #{w}, animFrameH = #{h} }|]

mkDurations :: [FrameInfo] -> ModuleFragment
mkDurations :: [FrameInfo] -> ModuleFragment
mkDurations = \case
  [] -> ModuleFragment
forall a. Monoid a => a
mempty
  [FrameInfo]
xs ->
    ModuleFragment
      { moduleFragmentImports :: [ModuleImport]
moduleFragmentImports =
          [ ModuleImport
              { moduleImportName :: FilePath
moduleImportName = FilePath
"Prelude"
              , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = ModuleImportStyle
ModuleImportStyleOpen
              }
          , ModuleImport
              { moduleImportName :: FilePath
moduleImportName = FilePath
"Data.Vector.Unboxed"
              , moduleImportStyle :: ModuleImportStyle
moduleImportStyle = Maybe FilePath -> ModuleImportStyle
ModuleImportStyleQualified (Maybe FilePath -> ModuleImportStyle)
-> Maybe FilePath -> ModuleImportStyle
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"U"
              }
          ]
      , moduleFragmentDeclarations :: [ModuleDeclaration]
moduleFragmentDeclarations =
          [ Bool -> DeclName -> DeclBody -> ModuleDeclaration
ModuleDeclaration Bool
False (FilePath -> DeclName
DeclName FilePath
durationsVecName) (DeclBody -> ModuleDeclaration) -> DeclBody -> ModuleDeclaration
forall a b. (a -> b) -> a -> b
$ FilePath -> DeclBody
DeclBody (FilePath -> DeclBody) -> FilePath -> DeclBody
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n"
              [ [i|#{durationsVecName} :: U.Vector Double|]
              , [i|#{durationsVecName} = U.fromListN #{length xs}|]
              , FilePath
"  [ " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"\n  , " (Double -> FilePath
forall a. Show a => a -> FilePath
show (Double -> FilePath)
-> (FrameInfo -> Double) -> FrameInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
toSeconds (Int -> Double) -> (FrameInfo -> Int) -> FrameInfo -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FrameInfo -> Int
duration (FrameInfo -> FilePath) -> [FrameInfo] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FrameInfo]
xs)
              , FilePath
"  ]"
              ]
          ]
      }
  where
  toSeconds :: Int -> Double
  toSeconds :: Int -> Double
toSeconds Int
ms = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000

type Atlas :: Type
data Atlas = Atlas
  { Atlas -> [FrameInfo]
frames :: [FrameInfo]
  , Atlas -> Meta
meta :: Meta
  } deriving stock ((forall x. Atlas -> Rep Atlas x)
-> (forall x. Rep Atlas x -> Atlas) -> Generic Atlas
forall x. Rep Atlas x -> Atlas
forall x. Atlas -> Rep Atlas x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Atlas -> Rep Atlas x
from :: forall x. Atlas -> Rep Atlas x
$cto :: forall x. Rep Atlas x -> Atlas
to :: forall x. Rep Atlas x -> Atlas
Generic)
    deriving anyclass (Maybe Atlas
Value -> Parser [Atlas]
Value -> Parser Atlas
(Value -> Parser Atlas)
-> (Value -> Parser [Atlas]) -> Maybe Atlas -> FromJSON Atlas
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Atlas
parseJSON :: Value -> Parser Atlas
$cparseJSONList :: Value -> Parser [Atlas]
parseJSONList :: Value -> Parser [Atlas]
$comittedField :: Maybe Atlas
omittedField :: Maybe Atlas
FromJSON)

type Meta :: Type
newtype Meta = Meta
  { Meta -> [FrameTag]
frameTags :: [FrameTag]
  } deriving stock ((forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Meta -> Rep Meta x
from :: forall x. Meta -> Rep Meta x
$cto :: forall x. Rep Meta x -> Meta
to :: forall x. Rep Meta x -> Meta
Generic)
    deriving anyclass (Maybe Meta
Value -> Parser [Meta]
Value -> Parser Meta
(Value -> Parser Meta)
-> (Value -> Parser [Meta]) -> Maybe Meta -> FromJSON Meta
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Meta
parseJSON :: Value -> Parser Meta
$cparseJSONList :: Value -> Parser [Meta]
parseJSONList :: Value -> Parser [Meta]
$comittedField :: Maybe Meta
omittedField :: Maybe Meta
FromJSON)

type FrameTag :: Type
data FrameTag = FrameTag
  { FrameTag -> TagNameField
name :: TagNameField
  , FrameTag -> Int
from :: Int
  , FrameTag -> Int
to :: Int
  , FrameTag -> Direction
direction :: Direction
  , FrameTag -> Maybe TagRepeat
repeat :: Maybe TagRepeat
  } deriving stock ((forall x. FrameTag -> Rep FrameTag x)
-> (forall x. Rep FrameTag x -> FrameTag) -> Generic FrameTag
forall x. Rep FrameTag x -> FrameTag
forall x. FrameTag -> Rep FrameTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FrameTag -> Rep FrameTag x
from :: forall x. FrameTag -> Rep FrameTag x
$cto :: forall x. Rep FrameTag x -> FrameTag
to :: forall x. Rep FrameTag x -> FrameTag
Generic)
    deriving anyclass (Maybe FrameTag
Value -> Parser [FrameTag]
Value -> Parser FrameTag
(Value -> Parser FrameTag)
-> (Value -> Parser [FrameTag])
-> Maybe FrameTag
-> FromJSON FrameTag
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FrameTag
parseJSON :: Value -> Parser FrameTag
$cparseJSONList :: Value -> Parser [FrameTag]
parseJSONList :: Value -> Parser [FrameTag]
$comittedField :: Maybe FrameTag
omittedField :: Maybe FrameTag
FromJSON)

type TagNameField :: Type
data TagNameField = TagNameField
  { TagNameField -> Text
file :: Text
  , TagNameField -> Text
tag :: Text
  }

instance FromJSON TagNameField where
  parseJSON :: Aeson.Value -> Aeson.Types.Parser TagNameField
  parseJSON :: Value -> Parser TagNameField
parseJSON = FilePath
-> (Text -> Parser TagNameField) -> Value -> Parser TagNameField
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText FilePath
"FromJSON TagNameField" \Text
t -> do
    case Parser TagNameField -> Text -> Either FilePath TagNameField
forall a. Parser a -> Text -> Either FilePath a
Attoparsec.parseOnly Parser TagNameField
tagnameFieldParser Text
t of
      Left FilePath
err -> FilePath -> Parser TagNameField
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err
      Right TagNameField
x -> TagNameField -> Parser TagNameField
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TagNameField
x

tagnameFieldParser :: Attoparsec.Parser TagNameField
tagnameFieldParser :: Parser TagNameField
tagnameFieldParser = do
  Text
file <- (Char -> Bool) -> Parser Text
Attoparsec.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')
  Char
_ <- Char -> Parser Char
Attoparsec.char Char
'|'
  Text
tag <- (Char -> Bool) -> Parser Text
Attoparsec.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')
  pure TagNameField { Text
$sel:file:TagNameField :: Text
file :: Text
file, Text
$sel:tag:TagNameField :: Text
tag :: Text
tag }

type TagRepeat :: Type
newtype TagRepeat = TagRepeat Int

instance FromJSON TagRepeat where
  parseJSON :: Aeson.Value -> Aeson.Types.Parser TagRepeat
  parseJSON :: Value -> Parser TagRepeat
parseJSON = FilePath -> (Text -> Parser TagRepeat) -> Value -> Parser TagRepeat
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText FilePath
"FromJSON TagRepeat" \Text
t -> do
    case Parser TagRepeat -> Text -> Either FilePath TagRepeat
forall a. Parser a -> Text -> Either FilePath a
Attoparsec.parseOnly Parser TagRepeat
tagRepeatParser Text
t of
      Left FilePath
err -> FilePath -> Parser TagRepeat
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err
      Right TagRepeat
x -> TagRepeat -> Parser TagRepeat
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TagRepeat
x

tagRepeatParser :: Attoparsec.Parser TagRepeat
tagRepeatParser :: Parser TagRepeat
tagRepeatParser = Int -> TagRepeat
TagRepeat (Int -> TagRepeat) -> Parser Text Int -> Parser TagRepeat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
forall a. Integral a => Parser a
Attoparsec.decimal

type Direction :: Type
data Direction
  = Forward
  | Reverse
  | Pingpong
  | PingpongReverse

instance FromJSON Direction where
  parseJSON :: Aeson.Value -> Aeson.Types.Parser Direction
  parseJSON :: Value -> Parser Direction
parseJSON = FilePath -> (Text -> Parser Direction) -> Value -> Parser Direction
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText FilePath
"FromJSON Direction" \case
    Text
"forward" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
Forward
    Text
"reverse" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
Reverse
    Text
"pingpong" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
Pingpong
    Text
"pingpong_reverse" -> Direction -> Parser Direction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
PingpongReverse
    Text
other -> FilePath -> Parser Direction
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser Direction) -> FilePath -> Parser Direction
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid direction: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
other

type FrameInfo :: Type
data FrameInfo = FrameInfo
  { FrameInfo -> FilenameField
filename :: FilenameField
  , FrameInfo -> Frame
frame :: Frame
  , FrameInfo -> Int
duration :: Int
  } deriving stock ((forall x. FrameInfo -> Rep FrameInfo x)
-> (forall x. Rep FrameInfo x -> FrameInfo) -> Generic FrameInfo
forall x. Rep FrameInfo x -> FrameInfo
forall x. FrameInfo -> Rep FrameInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FrameInfo -> Rep FrameInfo x
from :: forall x. FrameInfo -> Rep FrameInfo x
$cto :: forall x. Rep FrameInfo x -> FrameInfo
to :: forall x. Rep FrameInfo x -> FrameInfo
Generic, Int -> FrameInfo -> FilePath -> FilePath
[FrameInfo] -> FilePath -> FilePath
FrameInfo -> FilePath
(Int -> FrameInfo -> FilePath -> FilePath)
-> (FrameInfo -> FilePath)
-> ([FrameInfo] -> FilePath -> FilePath)
-> Show FrameInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FrameInfo -> FilePath -> FilePath
showsPrec :: Int -> FrameInfo -> FilePath -> FilePath
$cshow :: FrameInfo -> FilePath
show :: FrameInfo -> FilePath
$cshowList :: [FrameInfo] -> FilePath -> FilePath
showList :: [FrameInfo] -> FilePath -> FilePath
Show)
    deriving anyclass (Maybe FrameInfo
Value -> Parser [FrameInfo]
Value -> Parser FrameInfo
(Value -> Parser FrameInfo)
-> (Value -> Parser [FrameInfo])
-> Maybe FrameInfo
-> FromJSON FrameInfo
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FrameInfo
parseJSON :: Value -> Parser FrameInfo
$cparseJSONList :: Value -> Parser [FrameInfo]
parseJSONList :: Value -> Parser [FrameInfo]
$comittedField :: Maybe FrameInfo
omittedField :: Maybe FrameInfo
FromJSON)

framesVecName :: String
framesVecName :: FilePath
framesVecName = FilePath
"frames"

durationsVecName :: String
durationsVecName :: FilePath
durationsVecName = FilePath
"durations"

type FilenameField :: Type
data FilenameField = FilenameField
  { FilenameField -> Text
file :: Text
  , FilenameField -> 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.
  , FilenameField -> Int
frameIndex :: Int
  } deriving stock (Int -> FilenameField -> FilePath -> FilePath
[FilenameField] -> FilePath -> FilePath
FilenameField -> FilePath
(Int -> FilenameField -> FilePath -> FilePath)
-> (FilenameField -> FilePath)
-> ([FilenameField] -> FilePath -> FilePath)
-> Show FilenameField
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FilenameField -> FilePath -> FilePath
showsPrec :: Int -> FilenameField -> FilePath -> FilePath
$cshow :: FilenameField -> FilePath
show :: FilenameField -> FilePath
$cshowList :: [FilenameField] -> FilePath -> FilePath
showList :: [FilenameField] -> FilePath -> FilePath
Show)

mkBuilderName :: FilenameField -> String
mkBuilderName :: FilenameField -> FilePath
mkBuilderName FilenameField { Text
$sel:file:FilenameField :: FilenameField -> Text
file :: Text
file, Text
$sel:tag:FilenameField :: FilenameField -> Text
tag :: Text
tag } = [i|#{file}_#{tag}|]

instance FromJSON FilenameField where
  parseJSON :: Aeson.Value -> Aeson.Types.Parser FilenameField
  parseJSON :: Value -> Parser FilenameField
parseJSON = FilePath
-> (Text -> Parser FilenameField) -> Value -> Parser FilenameField
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText FilePath
"FromJSON FilenameField" \Text
t -> do
    case Parser FilenameField -> Text -> Either FilePath FilenameField
forall a. Parser a -> Text -> Either FilePath a
Attoparsec.parseOnly Parser FilenameField
filenameFieldParser Text
t of
      Left FilePath
err -> FilePath -> Parser FilenameField
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err
      Right FilenameField
x -> FilenameField -> Parser FilenameField
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilenameField
x

filenameFieldParser :: Attoparsec.Parser FilenameField
filenameFieldParser :: Parser FilenameField
filenameFieldParser = do
  Text
file <- (Char -> Char) -> Text -> Text
Text.map Char -> Char
sanitize (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
Attoparsec.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')
  Char
_ <- Char -> Parser Char
Attoparsec.char Char
'|'
  Text
tag <- (Char -> Char) -> Text -> Text
Text.map Char -> Char
sanitize (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
Attoparsec.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')
  Char
_ <- Char -> Parser Char
Attoparsec.char Char
'|'
  Int
frameIndex <- Parser Text Int
forall a. Integral a => Parser a
Attoparsec.decimal
  pure FilenameField { Text
$sel:file:FilenameField :: Text
file :: Text
file, Text
$sel:tag:FilenameField :: Text
tag :: Text
tag, Int
$sel:frameIndex:FilenameField :: Int
frameIndex :: Int
frameIndex }
  where
  sanitize :: Char -> Char
  sanitize :: Char -> Char
sanitize = \case
    Char
'-' -> Char
'_'
    Char
c -> Char
c

type Frame :: Type
data Frame = Frame
  { Frame -> Int
x :: Int
  , Frame -> Int
y :: Int
  , Frame -> Int
w :: Int
  , Frame -> Int
h :: Int
  } deriving stock ((forall x. Frame -> Rep Frame x)
-> (forall x. Rep Frame x -> Frame) -> Generic Frame
forall x. Rep Frame x -> Frame
forall x. Frame -> Rep Frame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Frame -> Rep Frame x
from :: forall x. Frame -> Rep Frame x
$cto :: forall x. Rep Frame x -> Frame
to :: forall x. Rep Frame x -> Frame
Generic, Int -> Frame -> FilePath -> FilePath
[Frame] -> FilePath -> FilePath
Frame -> FilePath
(Int -> Frame -> FilePath -> FilePath)
-> (Frame -> FilePath)
-> ([Frame] -> FilePath -> FilePath)
-> Show Frame
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Frame -> FilePath -> FilePath
showsPrec :: Int -> Frame -> FilePath -> FilePath
$cshow :: Frame -> FilePath
show :: Frame -> FilePath
$cshowList :: [Frame] -> FilePath -> FilePath
showList :: [Frame] -> FilePath -> FilePath
Show)
    deriving anyclass (Maybe Frame
Value -> Parser [Frame]
Value -> Parser Frame
(Value -> Parser Frame)
-> (Value -> Parser [Frame]) -> Maybe Frame -> FromJSON Frame
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Frame
parseJSON :: Value -> Parser Frame
$cparseJSONList :: Value -> Parser [Frame]
parseJSONList :: Value -> Parser [Frame]
$comittedField :: Maybe Frame
omittedField :: Maybe Frame
FromJSON)

optsParser :: Opt.ParserInfo PreprocessorOpts
optsParser :: ParserInfo PreprocessorOpts
optsParser = Parser PreprocessorOpts
-> InfoMod PreprocessorOpts -> ParserInfo PreprocessorOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser PreprocessorOpts
preprocessorOptsParser Parser PreprocessorOpts
-> Parser (PreprocessorOpts -> PreprocessorOpts)
-> Parser PreprocessorOpts
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (PreprocessorOpts -> PreprocessorOpts)
forall a. Parser (a -> a)
Opt.helper) (InfoMod PreprocessorOpts -> ParserInfo PreprocessorOpts)
-> InfoMod PreprocessorOpts -> ParserInfo PreprocessorOpts
forall a b. (a -> b) -> a -> b
$ [InfoMod PreprocessorOpts] -> InfoMod PreprocessorOpts
forall a. Monoid a => [a] -> a
mconcat
  [ InfoMod PreprocessorOpts
forall a. InfoMod a
Opt.fullDesc
  , FilePath -> InfoMod PreprocessorOpts
forall a. FilePath -> InfoMod a
Opt.progDesc FilePath
"Convert an Aseprite texture atlas JSON into Haskell code"
  , FilePath -> InfoMod PreprocessorOpts
forall a. FilePath -> InfoMod a
Opt.header FilePath
"aseprite2haskell - Aseprite -> Haskell preprocessor"
  ]

type PreprocessorOpts :: Type
data PreprocessorOpts = PreprocessorOpts
  { PreprocessorOpts -> FilePath
preprocessorOptsOrigSourceFile :: FilePath
  , PreprocessorOpts -> FilePath
preprocessorOptsOutputFile :: FilePath
  } deriving stock (Int -> PreprocessorOpts -> FilePath -> FilePath
[PreprocessorOpts] -> FilePath -> FilePath
PreprocessorOpts -> FilePath
(Int -> PreprocessorOpts -> FilePath -> FilePath)
-> (PreprocessorOpts -> FilePath)
-> ([PreprocessorOpts] -> FilePath -> FilePath)
-> Show PreprocessorOpts
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> PreprocessorOpts -> FilePath -> FilePath
showsPrec :: Int -> PreprocessorOpts -> FilePath -> FilePath
$cshow :: PreprocessorOpts -> FilePath
show :: PreprocessorOpts -> FilePath
$cshowList :: [PreprocessorOpts] -> FilePath -> FilePath
showList :: [PreprocessorOpts] -> FilePath -> FilePath
Show)

preprocessorOptsParser :: Opt.Parser PreprocessorOpts
preprocessorOptsParser :: Parser PreprocessorOpts
preprocessorOptsParser = do
  FilePath
preprocessorOptsOrigSourceFile <- ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opt.argument ReadM FilePath
forall s. IsString s => ReadM s
Opt.str (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"SOURCE"
    , FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"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.
  FilePath
_ <- forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opt.argument @String ReadM FilePath
forall s. IsString s => ReadM s
Opt.str (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"INPUT"
    , FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Input filepath (passed by GHC)"
    ]
  FilePath
preprocessorOptsOutputFile <- ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opt.argument ReadM FilePath
forall s. IsString s => ReadM s
Opt.str (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"OUTPUT"
    , FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Output filepath (passed by GHC)"
    ]
  pure PreprocessorOpts
    { FilePath
$sel:preprocessorOptsOrigSourceFile:PreprocessorOpts :: FilePath
preprocessorOptsOrigSourceFile :: FilePath
preprocessorOptsOrigSourceFile
    , FilePath
$sel:preprocessorOptsOutputFile:PreprocessorOpts :: FilePath
preprocessorOptsOutputFile :: FilePath
preprocessorOptsOutputFile
    }