justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove some flat instances in an effort to allow compilation

Browse Source
This commit is contained in:
justin
2022-08-21 10:10:52 +01:00
parent 6e598339f1
commit 55c3a195c9
7 changed files with 38 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
package.yaml
+1 -1
View File
@@ -131,7 +131,7 @@ benchmarks:
- -funfolding-use-threshold1000
- -funfolding-keeness-factor1000
- -fllvm
- -optlo-O3
#- -optlo-O3
main: Bench.hs
source-dirs: bench
src/Dodge/Data/Button.hs
+4 -2
View File
@@ -44,7 +44,8 @@ data ButtonEvent
, _boffEff :: WdWd
}
| ButtonAccessTerminal
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data Button = Button
{ _btPict :: ButtonDraw --Button -> SPic
@@ -58,7 +59,8 @@ data Button = Button
, _btName :: String
, _btColor :: Color
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Ord, Show, Read, Generic, Flat)
src/Dodge/Data/CWorld.hs
+4 -2
View File
@@ -187,7 +187,8 @@ data CWorld = CWorld
, _cwTime :: CWTime
, _cwGen :: CWGen
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data CWTime = CWTime
{ _maybeWorld :: Maybe' CWorld
@@ -195,7 +196,8 @@ data CWTime = CWTime
, _worldClock :: Int
, _deathDelay :: Maybe Int
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data CWGen = CWGen
src/Dodge/Data/Terminal.hs
+12 -6
View File
@@ -28,7 +28,8 @@ data TerminalInput = TerminalInput
data TerminalBootProgram
= TerminalBootMempty
| TerminalBootLines [TerminalLine]
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data Terminal = Terminal
{ _tmID :: Int
@@ -48,7 +49,8 @@ data Terminal = Terminal
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data TerminalLineString = TerminalLineConst String Color
deriving (Eq, Ord, Show, Read, Generic, Flat)
@@ -72,7 +74,8 @@ data TerminalLine
{ _tlPause :: Int
, _tlEffect :: TmWdWd --Terminal -> World -> World
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
@@ -92,7 +95,8 @@ data EffectArguments
{ _argType :: String
, _argList :: M.Map String [TerminalLine]
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data TerminalCommandEffect
= TerminalCommandArguments EffectArguments
@@ -104,7 +108,8 @@ data TerminalCommandEffect
| TerminalCommandEffectCommands
| TerminalCommandEffectSingleCommand WdWd [String]
| TerminalCommandEffectNone
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data TerminalCommand = TerminalCommand
{ _tcString :: String
@@ -112,7 +117,8 @@ data TerminalCommand = TerminalCommand
, _tcHelp :: String
, _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
}
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
makeLenses ''TerminalInput
makeLenses ''Terminal
src/Dodge/Data/WorldEffect.hs
+4 -2
View File
@@ -32,7 +32,8 @@ data WdWd
| WdWdNegateTrig Int
| WdWdFromItixCrixWdWd Int Int ItCrWdWd
| WdWdFromItCrixWdWd Item Int ItCrWdWd
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
data WdP2
= WdP2Const Point2
@@ -74,7 +75,8 @@ data TmWdWd
| TmWdWdfromWdWd WdWd
| TmWdWdTermSound SoundID
| TmWdWdDoDeathTriggers
deriving (Eq, Show, Read, Generic, Flat)
deriving (Eq, Show, Read, Generic)
--hderiving (Eq, Show, Read, Generic, Flat)
deriveJSON defaultOptions ''ItCrWdWd
deriveJSON defaultOptions ''WdWd
src/Dodge/Menu/.OptionType.hs.swo
BIN
View File
Binary file not shown.
src/Dodge/Save.hs
+13 -12
View File
@@ -26,23 +26,24 @@ writeSaveSlot :: SaveSlot -> Universe -> IO (Universe -> Maybe Universe)
writeSaveSlot ss u = do
putStrLn $ "Saving " ++ saveSlotPath ss
createDirectoryIfMissing True "saveSlot"
BSS.writeFile (saveSlotPath ss) $
flat
(u ^. uvWorld . cWorld)
-- BSS.writeFile (saveSlotPath ss) $
-- flat
-- (u ^. uvWorld . cWorld)
return Just
readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe)
readSaveSlot ss = do
fExists <- doesFileExist $ saveSlotPath ss
if fExists
then do
bsstr <- BSS.readFile $ saveSlotPath ss
let cwstr = unflat bsstr
case cwstr of
Left _ -> putStrLn "loadSaveSlot failed to read saved file" >> return removescreenlayers
Right cw -> return $ \uv -> Just $ uv & uvWorld . cWorld .~ cw
& uvScreenLayers .~ []
else putStrLn "loadSaveSlot failed to find saved file" >> return removescreenlayers
-- if fExists
-- then do
-- bsstr <- BSS.readFile $ saveSlotPath ss
-- let cwstr = unflat bsstr
-- case cwstr of
-- Left _ -> putStrLn "loadSaveSlot failed to read saved file" >> return removescreenlayers
-- Right cw -> return $ \uv -> Just $ uv & uvWorld . cWorld .~ cw
-- & uvScreenLayers .~ []
-- else putStrLn "loadSaveSlot failed to find saved file" >> return removescreenlayers
return Just
where
removescreenlayers = Just . (uvScreenLayers .~ [])