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

Remove a lot of IO/maybe cruft

Browse Source
This commit is contained in:
justin
2022-10-30 16:11:30 +00:00
parent 624a4c3bcd
commit 219379393e
9 changed files with 85 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Universe.hs
+5 -5
View File
@@ -49,7 +49,7 @@ data ScreenLayer
= OptionScreen = OptionScreen
{ _scTitle :: Universe -> String { _scTitle :: Universe -> String
, _scOptions :: [MenuOption] , _scOptions :: [MenuOption]
, _scDefaultEff :: Universe -> IO (Maybe Universe) , _scDefaultEff :: Universe -> Universe
, _scOptionFlag :: OptionScreenFlag , _scOptionFlag :: OptionScreenFlag
, _scOptionsOffset :: Int , _scOptionsOffset :: Int
} }
@@ -77,20 +77,20 @@ data MenuOptionDisplay
data MenuOption data MenuOption
= Toggle = Toggle
{ _moEff :: Universe -> IO (Maybe Universe) { _moEff :: Universe -> Universe
, _moString :: Universe -> MenuOptionDisplay , _moString :: Universe -> MenuOptionDisplay
, _moKey :: Scancode , _moKey :: Scancode
} }
| Toggle2 | Toggle2
{ _moKey1 :: Scancode { _moKey1 :: Scancode
, _moEff1 :: Universe -> IO (Maybe Universe) , _moEff1 :: Universe -> Universe
, _moKey2 :: Scancode , _moKey2 :: Scancode
, _moEff2 :: Universe -> IO (Maybe Universe) , _moEff2 :: Universe -> Universe
, _moString :: Universe -> MenuOptionDisplay , _moString :: Universe -> MenuOptionDisplay
} }
| InvisibleToggle | InvisibleToggle
{ _moKey :: Scancode { _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe) , _moEff :: Universe -> Universe
} }
data IntID a = IntID Int a data IntID a = IntID Int a
src/Dodge/Debug/Terminal.hs
+32 -32
View File
@@ -5,15 +5,15 @@ module Dodge.Debug.Terminal where
import Dodge.Item.Location.Initialize import Dodge.Item.Location.Initialize
import Control.Applicative import Control.Applicative
import Control.Lens import Control.Lens
import Control.Monad --import Control.Monad
import Data.List --import Data.List
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Dodge.Creature import Dodge.Creature
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Inventory.Add import Dodge.Inventory.Add
import Dodge.Item import Dodge.Item
import Dodge.Menu.PushPop --import Dodge.Menu.PushPop
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import LensHelp import LensHelp
import MaybeHelp import MaybeHelp
@@ -75,35 +75,35 @@ applySetTerminalString var = case key' of
val' = readMaybe val :: Maybe Float val' = readMaybe val :: Maybe Float
key' = if isNothing val' then "" else key key' = if isNothing val' then "" else key
autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe) --autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
autoCompleteTerminal s _ = --autoCompleteTerminal s _ =
return -- return
. (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands)) -- . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
where -- where
(key, val) = getSplitString $ tail s -- (key, val) = getSplitString $ tail s
command_options = case val of -- command_options = case val of
"" -> filter (isInfixOf key) (validTerminalCommands "") -- "" -> filter (isInfixOf key) (validTerminalCommands "")
_ -> filter (isInfixOf val) (validTerminalCommands key) -- _ -> filter (isInfixOf val) (validTerminalCommands key)
-- basic autocomplete if single option available (or as far as possible) -- -- basic autocomplete if single option available (or as far as possible)
input_str = case (key, val) of -- input_str = case (key, val) of
(_, "") -> -- (_, "") ->
if length command_options == 1 -- if length command_options == 1
then ">" ++ head command_options ++ " " -- then ">" ++ head command_options ++ " "
else ">" ++ longestCommonPrefix command_options -- else ">" ++ longestCommonPrefix command_options
_ -> -- _ ->
if length command_options == 1 -- if length command_options == 1
then ">" ++ key ++ " " ++ head command_options ++ " " -- then ">" ++ key ++ " " ++ head command_options ++ " "
else -- else
if null command_options -- if null command_options
then s -- then s
else ">" ++ key ++ " " ++ longestCommonPrefix command_options -- else ">" ++ key ++ " " ++ longestCommonPrefix command_options
command_options' = -- command_options' =
if not (null command_options) && head command_options == key -- if not (null command_options) && head command_options == key
then validTerminalCommands key -- then validTerminalCommands key
else command_options -- else command_options
--
--val' = Debug.Trace.trace key tail val -- --val' = Debug.Trace.trace key tail val
valid_commands = "Options: " ++ intercalate ", " command_options' -- valid_commands = "Options: " ++ intercalate ", " command_options'
getSplitString :: [Char] -> ([Char], [Char]) getSplitString :: [Char] -> ([Char], [Char])
getSplitString str = case break (== ' ') str of getSplitString str = case break (== ' ') str of
src/Dodge/Event.hs
+1 -1
View File
@@ -24,7 +24,7 @@ import SDL
handleEvent :: Event -> Universe -> IO (Maybe Universe) handleEvent :: Event -> Universe -> IO (Maybe Universe)
handleEvent e = case eventPayload e of handleEvent e = case eventPayload e of
TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev) TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
KeyboardEvent kev -> handleKeyboardEvent kev KeyboardEvent kev -> return . Just . handleKeyboardEvent kev
MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev) MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
src/Dodge/Event/Keyboard.hs
+9 -9
View File
@@ -47,9 +47,9 @@ On release, remove scancode from the 'Set' of pressed keys.
On press, adds the scancode, and perhaps applies a direct effect: On press, adds the scancode, and perhaps applies a direct effect:
see 'handlePressedKeyInGame'. see 'handlePressedKeyInGame'.
-} -}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe) handleKeyboardEvent :: KeyboardEventData -> Universe -> Universe
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . input . pressedKeys . at scode .~ Nothing Released -> u & uvWorld . input . pressedKeys . at scode .~ Nothing
Pressed -> Pressed ->
handlePressedKey handlePressedKey
(keyboardEventRepeat kev) (keyboardEventRepeat kev)
@@ -61,17 +61,17 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
| otherwise = InitialPress | otherwise = InitialPress
scode = (keysymScancode . keyboardEventKeysym) kev scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey :: Bool -> Scancode -> Universe -> Universe
handlePressedKey True _ u = return $ Just u handlePressedKey True _ u = u
handlePressedKey _ scode u = case scode of handlePressedKey _ scode u = case scode of
ScancodeF5 -> return . Just $ doQuicksave u ScancodeF5 -> doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u ScancodeF9 -> loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u ScancodeSemicolon -> gotoTerminal u
_ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of _ | null (_uvScreenLayers u) -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) Just (DisplayTerminal tmid)
| inTermFocus (_uvWorld u) -> | inTermFocus (_uvWorld u) ->
return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u over uvWorld (handlePressedKeyTerminal tmid scode) u
_ -> return $ Just u _ -> u
_ -> handlePressedKeyInMenu (head $ _uvScreenLayers u) scode u _ -> handlePressedKeyInMenu (head $ _uvScreenLayers u) scode u
handlePressedKeyTerminal :: Int -> Scancode -> World -> World handlePressedKeyTerminal :: Int -> Scancode -> World -> World
src/Dodge/Event/Menu.hs
+6 -7
View File
@@ -8,24 +8,23 @@ import Dodge.Data.Universe
import Dodge.WindowLayout import Dodge.WindowLayout
import SDL import SDL
handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> Universe
handlePressedKeyInMenu mState scode = case mState of handlePressedKeyInMenu mState scode = case mState of
OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> OptionScreen{_scOptions = mos, _scDefaultEff = defeff} ->
optionListToEffects defeff scode mos optionListToEffects defeff scode mos
--DisplayScreen{} -> popScreen --DisplayScreen{} -> popScreen
-- WaitScreen{} -> return . Just -- WaitScreen{} -> return . Just
_ -> return . Just _ -> id
optionListToEffects :: optionListToEffects ::
(Universe -> IO (Maybe Universe)) -> (Universe -> Universe) ->
Scancode -> Scancode ->
[MenuOption] -> [MenuOption] ->
Universe -> Universe ->
IO (Maybe Universe) Universe
optionListToEffects defaulteff sc mops u = case sc of optionListToEffects defaulteff sc mops u = case sc of
ScancodeSpace -> ScancodeSpace ->
return . Just (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines)))
. (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines)))
$ u $ u
_ -> _ ->
( fromMaybe defaulteff ( fromMaybe defaulteff
@@ -40,7 +39,7 @@ optionListToEffects defaulteff sc mops u = case sc of
| otherwise = x | otherwise = x
mlines = availableMenuLines $ _uvConfig u mlines = availableMenuLines $ _uvConfig u
menuOptionToEffects :: MenuOption -> [(Scancode, Universe -> IO (Maybe Universe))] menuOptionToEffects :: MenuOption -> [(Scancode, Universe -> Universe)]
menuOptionToEffects Toggle{_moKey = k, _moEff = eff} = [(k, eff)] menuOptionToEffects Toggle{_moKey = k, _moEff = eff} = [(k, eff)]
menuOptionToEffects InvisibleToggle{_moKey = k, _moEff = eff} = [(k, eff)] menuOptionToEffects InvisibleToggle{_moKey = k, _moEff = eff} = [(k, eff)]
menuOptionToEffects menuOptionToEffects
src/Dodge/Menu.hs
+25 -27
View File
@@ -25,20 +25,20 @@ import Data.Maybe
splashMenu :: ScreenLayer splashMenu :: ScreenLayer
splashMenu = splashMenu =
slTitleOptionsEff "AMNESIS" splashMenuOptions (return . Just) slTitleOptionsEff "AMNESIS" splashMenuOptions id
& scOptionFlag .~ SplashOptions & scOptionFlag .~ SplashOptions
splashMenuOptions :: [MenuOption] splashMenuOptions :: [MenuOption]
splashMenuOptions = splashMenuOptions =
basicKeyOptions basicKeyOptions
[ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) displaycontinue [ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED") , Toggle ( startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
, Toggle (return . Just . reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED") , Toggle ( reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS") , Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS") , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (displaywhenseed "VIEW LAST SEED") , Toggle (id) (displaywhenseed "VIEW LAST SEED")
, Toggle (return . const Nothing) (opText "QUIT") , Toggle (id) (opText "QUIT")
] ]
where where
opText = const . MODString opText = const . MODString
@@ -48,30 +48,27 @@ splashMenuOptions =
| otherwise = MODString str | otherwise = MODString str
pauseMenu :: ScreenLayer pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (unpause)
pauseMenuOptions :: [MenuOption] pauseMenuOptions :: [MenuOption]
pauseMenuOptions = pauseMenuOptions =
basicKeyOptions basicKeyOptions
[ Toggle popScreen (opText "CONTINUE") [ Toggle popScreen (opText "CONTINUE")
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME") , Toggle (startNewGameInSlot 0) (opText "NEW GAME")
, Toggle (return . Just . reloadLevelStart) (opText "RESTART") , Toggle (reloadLevelStart) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS") , Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS") , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (opText "VIEW CURRENT SEED") , Toggle id (opText "VIEW CURRENT SEED")
, Toggle saveQuit (opText "SAVE AND QUIT") , Toggle saveQuit (opText "SAVE AND QUIT")
] ]
++ [ InvisibleToggle ScancodeEscape (return . const Nothing) ++ [ InvisibleToggle ScancodeEscape id
] ]
where where
opText = const . MODString opText = const . MODString
saveQuit :: Universe -> IO (Maybe Universe) saveQuit :: Universe -> Universe
saveQuit u = saveQuit u = u & addSideEffect (saveQuitConc u) "SAVING"
return $
Just $
u & addSideEffect (saveQuitConc u) "SAVING"
saveQuitConc :: Universe -> IO (Universe -> Maybe Universe) saveQuitConc :: Universe -> IO (Universe -> Maybe Universe)
saveQuitConc u = do saveQuitConc u = do
@@ -83,19 +80,19 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption] seedStartOptions :: [MenuOption]
seedStartOptions = seedStartOptions =
[ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA [ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER") -- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
] ]
trySeedFromClipboard :: Universe -> IO (Maybe Universe) trySeedFromClipboard :: Universe -> IO Universe
trySeedFromClipboard u = do trySeedFromClipboard u = do
mcstr <- getClipboardString mcstr <- getClipboardString
case mcstr >>= readMaybe of case mcstr >>= readMaybe of
Nothing -> Nothing ->
pushScreen return $ pushScreen
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER") (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & uvScreenLayers %~ tail) (u & uvScreenLayers %~ tail)
Just i -> return . Just $ startSeedGame 0 i u Just i -> return $ startSeedGame 0 i u
slTitleOptions :: String -> [MenuOption] -> ScreenLayer slTitleOptions :: String -> [MenuOption] -> ScreenLayer
slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig)
@@ -122,13 +119,13 @@ debugMenuOptions :: [MenuOption]
debugMenuOptions = debugMenuOptions =
zipWith zipWith
($) ($)
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return]) (map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id])
$ map Scancode [4 ..] $ map Scancode [4 ..]
where where
f :: DebugBool -> Scancode -> MenuOption f :: DebugBool -> Scancode -> MenuOption
f bd = f bd =
Toggle Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust)) ((uvConfig . debug_booleans . at bd %~ toggleJust))
(uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd)) (uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False") g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True") g bd _ = (show bd, "True")
@@ -182,7 +179,8 @@ soundMenuOptions =
scod2 scod2
(change inc stype) (change inc stype)
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int))) (\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g) change g vt uv = uv & uvConfig . vt %~ g
& uvIOEffects .~ \u -> sw uv >> return u
dec x = max 0 (x - 0.1) dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1) inc x = min 1 (x + 0.1)
sw w = setVol (_uvConfig w) sw w = setVol (_uvConfig w)
@@ -196,7 +194,7 @@ graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
graphicsMenuOptions :: [MenuOption] graphicsMenuOptions :: [MenuOption]
graphicsMenuOptions = graphicsMenuOptions =
basicKeyOptions basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
, makeBoolOption graphics_wall_textured "WALL TEXTURES" , makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS" , makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS" , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
@@ -204,7 +202,7 @@ graphicsMenuOptions =
gameOverMenu :: ScreenLayer gameOverMenu :: ScreenLayer
gameOverMenu = gameOverMenu =
slTitleOptionsEff "GAME OVER" pauseMenuOptions (return . Just) slTitleOptionsEff "GAME OVER" pauseMenuOptions id
& scOptionFlag .~ GameOverOptions & scOptionFlag .~ GameOverOptions
-- OptionScreen -- OptionScreen
@@ -218,8 +216,8 @@ gameOverMenu =
--charToScode :: Char -> Scancode --charToScode :: Char -> Scancode
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
unpause :: Universe -> Maybe Universe unpause :: Universe -> Universe
unpause w = Just . resumeSound $ w & uvScreenLayers .~ [] unpause w = resumeSound $ w & uvScreenLayers .~ []
displayControls :: ScreenLayer displayControls :: ScreenLayer
displayControls = ColumnsScreen (const "CONTROLS") listControls displayControls = ColumnsScreen (const "CONTROLS") listControls
src/Dodge/Menu/Option.hs
+1 -1
View File
@@ -2,7 +2,7 @@ module Dodge.Menu.Option
where where
import Dodge.Data.Universe import Dodge.Data.Universe
slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> Universe) -> ScreenLayer
slTitleOptionsEff title ops eff = slTitleOptionsEff title ops eff =
OptionScreen OptionScreen
{ _scTitle = const title { _scTitle = const title
src/Dodge/Menu/OptionType.hs
+2 -2
View File
@@ -7,12 +7,12 @@ import Dodge.Menu.PushPop
makeBoolOption lns t = makeBoolOption lns t =
Toggle Toggle
(return . Just . (uvConfig . lns #%~ not)) (uvConfig . lns #%~ not)
(\u -> MODStringOption t (show (u ^# uvConfig . lns))) (\u -> MODStringOption t (show (u ^# uvConfig . lns)))
makeEnumOption lns str sideeff = makeEnumOption lns str sideeff =
Toggle Toggle
(\u -> Just <$> sideeff (u & uvConfig . lns #%~ cycleEnum)) (\u -> sideeff (u & uvConfig . lns #%~ cycleEnum))
(\u -> MODStringOption str (show (u ^# uvConfig . lns))) (\u -> MODStringOption str (show (u ^# uvConfig . lns)))
makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t) makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
src/Dodge/Menu/PushPop.hs
+4 -9
View File
@@ -3,14 +3,9 @@ module Dodge.Menu.PushPop where
import Dodge.Data.Universe import Dodge.Data.Universe
import LensHelp import LensHelp
popScreen' :: Universe -> Maybe Universe popScreen :: Universe -> Universe
popScreen' = Just . (uvScreenLayers %~ tail) popScreen = uvScreenLayers %~ tail
popScreen :: Universe -> IO (Maybe Universe) pushScreen :: ScreenLayer -> Universe -> Universe
popScreen = return . popScreen' pushScreen ml = (uvScreenLayers .:~ ml)
pushScreen' :: ScreenLayer -> Universe -> Maybe Universe
pushScreen' ml = Just . (uvScreenLayers .:~ ml)
pushScreen :: ScreenLayer -> Universe -> IO (Maybe Universe)
pushScreen ml = return . pushScreen' ml