From c82e10c4285880a37797a362d74bfb012a6abc52 Mon Sep 17 00:00:00 2001 From: Michael Tolly Date: Wed, 18 Sep 2019 22:23:21 -0500 Subject: [PATCH] Work around bugged yaml 'encodeFile' on Windows --- haskell/src-exe/GUI/FLTK.hs | 6 +++--- haskell/src/DTXMania/Import.hs | 5 ++--- haskell/src/GuitarHeroI/Import.hs | 5 ++--- haskell/src/GuitarHeroII/Import.hs | 5 ++--- haskell/src/Import.hs | 10 +++++----- haskell/src/JSONData.hs | 7 +++++++ 6 files changed, 21 insertions(+), 17 deletions(-) diff --git a/haskell/src-exe/GUI/FLTK.hs b/haskell/src-exe/GUI/FLTK.hs index bccf54529..32e58a34e 100644 --- a/haskell/src-exe/GUI/FLTK.hs +++ b/haskell/src-exe/GUI/FLTK.hs @@ -49,7 +49,6 @@ import Data.Maybe (catMaybes, import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Version (showVersion) -import qualified Data.Yaml as Y import DryVox import Foreign (Ptr) import Foreign.C (CString, @@ -63,7 +62,8 @@ import Graphics.UI.FLTK.LowLevel.FLTKHS (Height (..), Width (..), X (..), Y (..)) import qualified Graphics.UI.FLTK.LowLevel.FLTKHS as FL -import JSONData (toJSON) +import JSONData (toJSON, + yamlEncodeFile) import Magma (oggToMogg) import Network.HTTP.Req ((/:)) import qualified Network.HTTP.Req as Req @@ -352,7 +352,7 @@ forceProDrums song = song saveProject :: Project -> SongYaml -> IO Project saveProject proj song = do - Y.encodeFile (projectLocation proj) $ toJSON song + yamlEncodeFile (projectLocation proj) $ toJSON song return proj { projectSongYaml = song } data GBKOption diff --git a/haskell/src/DTXMania/Import.hs b/haskell/src/DTXMania/Import.hs index 4c4368ae0..0e6d05254 100644 --- a/haskell/src/DTXMania/Import.hs +++ b/haskell/src/DTXMania/Import.hs @@ -21,11 +21,10 @@ import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe, mapMaybe) import qualified Data.Text as T -import qualified Data.Yaml as Y import DTXMania.DTX import DTXMania.Set import Guitars (emit5') -import JSONData (toJSON) +import JSONData (toJSON, yamlEncodeFile) import qualified RockBand.Codec.Drums as D import RockBand.Codec.File (FlexPartName (..)) import qualified RockBand.Codec.File as RBFile @@ -248,7 +247,7 @@ importSetDef setDefPath song dout = do translateDifficulty (Just lvl) dec = let lvl' = (fromIntegral lvl + maybe 0 ((/ 10) . fromIntegral) dec) / 100 :: Rational in Rank $ max 1 $ round $ lvl' * 525 -- arbitrary scaling factor - stackIO $ Y.encodeFile (dout "song.yml") $ toJSON $ addAudio SongYaml + stackIO $ yamlEncodeFile (dout "song.yml") $ toJSON $ addAudio SongYaml { _metadata = def { _title = case setTitle song of "" -> dtx_TITLE topDiffDTX diff --git a/haskell/src/GuitarHeroI/Import.hs b/haskell/src/GuitarHeroI/Import.hs index 0d7fb1bf8..1fcf44257 100644 --- a/haskell/src/GuitarHeroI/Import.hs +++ b/haskell/src/GuitarHeroI/Import.hs @@ -23,11 +23,10 @@ import qualified Data.Map as Map import Data.Maybe (catMaybes) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1) -import qualified Data.Yaml as Y import GuitarHeroI.File import GuitarHeroII.Audio (readVGS) import GuitarHeroII.PartGuitar -import JSONData (toJSON) +import JSONData (toJSON, yamlEncodeFile) import qualified RockBand.Codec.Events as RB import qualified RockBand.Codec.File as RBFile import qualified RockBand.Codec.Five as RB @@ -96,7 +95,7 @@ importGH1 pkg gen dout = do let f = "vgs-" <> show (i :: Int) <> ".wav" runAudio (CA.mapSamples CA.fractionalSample src) $ dout f return f - stackIO $ Y.encodeFile (dout "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dout "song.yml") $ toJSON SongYaml { _metadata = def { _title = Just $ name pkg , _artist = Just $ artist pkg diff --git a/haskell/src/GuitarHeroII/Import.hs b/haskell/src/GuitarHeroII/Import.hs index 00e4ba707..fce0992c4 100644 --- a/haskell/src/GuitarHeroII/Import.hs +++ b/haskell/src/GuitarHeroII/Import.hs @@ -23,13 +23,12 @@ import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1) -import qualified Data.Yaml as Y import GuitarHeroII.Audio (readVGS) import GuitarHeroII.Events import GuitarHeroII.File import GuitarHeroII.PartGuitar import GuitarHeroII.Triggers -import JSONData (toJSON) +import JSONData (toJSON, yamlEncodeFile) import qualified RockBand.Codec.Events as RB import qualified RockBand.Codec.File as RBFile import qualified RockBand.Codec.Five as RB @@ -131,7 +130,7 @@ importGH2 mode pkg gen dout = do let f = "vgs-" <> show (i :: Int) <> ".wav" runAudio (CA.mapSamples CA.fractionalSample src) $ dout f return f - stackIO $ Y.encodeFile (dout "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dout "song.yml") $ toJSON SongYaml { _metadata = def { _title = Just $ name pkg <> case mode of ImportSolo -> "" diff --git a/haskell/src/Import.hs b/haskell/src/Import.hs index d0899ab2d..6f1a4e5bf 100644 --- a/haskell/src/Import.hs +++ b/haskell/src/Import.hs @@ -51,7 +51,7 @@ import qualified FeedBack.Load as FB import qualified FretsOnFire as FoF import Image (DXTFormat (PNGXbox), toDXT1File) -import JSONData (toJSON) +import JSONData (toJSON, yamlEncodeFile) import Magma (getRBAFile) import qualified Numeric.NonNegative.Class as NNC import OSFiles (fixFileCase) @@ -336,7 +336,7 @@ importFoF src dest = do Just True -> 250 -- don't know exactly _ -> 170 - stackIO $ Y.encodeFile (dest "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dest "song.yml") $ toJSON SongYaml { _metadata = Metadata { _title = title , _artist = FoF.artist song @@ -859,7 +859,7 @@ importRB3 pkg meta karaoke multitrack hasKicks mid updateMid files2x mogg mcover let bassBase = detectExtProBass fixedTracks - stackIO $ Y.encodeFile (dir "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dir "song.yml") $ toJSON SongYaml { _metadata = Metadata { _title = _title meta <|> Just (D.name pkg) , _artist = Just $ D.artist pkg @@ -1136,7 +1136,7 @@ importMagma fin dir = do tuneGtr <- inside "Reading pro guitar tuning" $ readTuning C3.proGuitarTuning "real_guitar_tuning" tuneBass <- inside "Reading pro bass tuning" $ readTuning C3.proBassTuning4 "real_bass_tuning" - stackIO $ Y.encodeFile (dir "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dir "song.yml") $ toJSON SongYaml { _metadata = Metadata { _title = Just title , _artist = Just $ maybe (RBProj.artistName $ RBProj.metadata rbproj) C3.artist c3 @@ -1383,7 +1383,7 @@ importAmplitude fin dout = do return (name, mempty { RBFile.onyxCatch = trk }) } stackIO $ Dir.copyFile moggPath $ dout "audio.mogg" - stackIO $ Y.encodeFile (dout "song.yml") $ toJSON SongYaml + stackIO $ yamlEncodeFile (dout "song.yml") $ toJSON SongYaml { _metadata = def { _title = Just $ Amp.title song , _artist = Just $ case Amp.artist_short song of diff --git a/haskell/src/JSONData.hs b/haskell/src/JSONData.hs index 4bd29736f..7fbf4982f 100644 --- a/haskell/src/JSONData.hs +++ b/haskell/src/JSONData.hs @@ -15,6 +15,7 @@ import Control.Monad.Trans.StackTrace import Control.Monad.Trans.State import Control.Monad.Trans.Writer import qualified Data.Aeson as A +import qualified Data.ByteString as B import Data.Functor.Identity (Identity (..)) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as Set @@ -22,6 +23,7 @@ import Data.Maybe (isJust) import Data.Scientific import qualified Data.Text as T import qualified Data.Vector as V +import qualified Data.Yaml as Y type StackParser m v = StackTraceT (ReaderT v m) @@ -289,3 +291,8 @@ toJSON = makeValue stackJSON fromJSON :: (SendMessage m, StackJSON a) => StackParser m A.Value a fromJSON = codecIn stackJSON + +-- | 'Y.encodeFile' as of 2019-09-18 has been observed to be bugged on Windows, +-- because it does not truncate or remove an existing file at the location. +yamlEncodeFile :: (Y.ToJSON a) => FilePath -> a -> IO () +yamlEncodeFile f x = B.writeFile f $ Y.encode x