Skip to content

Commit

Permalink
Work around bugged yaml 'encodeFile' on Windows
Browse files Browse the repository at this point in the history
  • Loading branch information
@mtolly
mtolly committed Sep 19, 2019
1 parent fff5086 commit c82e10c
Show file tree
Hide file tree
Showing 6 changed files with 21 additions and 17 deletions.
6 changes: 3 additions & 3 deletions haskell/src-exe/GUI/FLTK.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions haskell/src/DTXMania/Import.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions haskell/src/GuitarHeroI/Import.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions haskell/src/GuitarHeroII/Import.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 -> ""
Expand Down
10 changes: 5 additions & 5 deletions haskell/src/Import.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
7 changes: 7 additions & 0 deletions haskell/src/JSONData.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,15 @@ 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
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)

Expand Down Expand Up @@ -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

0 comments on commit c82e10c

Please sign in to comment.