made callbacks pure

src/Mtlstats/Actions.hs

@@ -34,7 +34,6 @@ module Mtlstats.Actions
   , addPlayer
   ) where
 
-import Control.Monad.Trans.State (modify)
 import Data.Maybe (fromMaybe)
 import Data.Time.Calendar (fromGregorianValid)
 import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
@@ -118,7 +117,7 @@ validateGameDate s = fromMaybe s $ do
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
-  cb = modify $ progMode .~ MainMenu
+  cb = progMode .~ MainMenu
   cps
     = newCreatePlayerState
     & cpsSuccessCallback .~ cb

src/Mtlstats/Control.hs

@@ -21,7 +21,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (join, when)
+import Control.Monad (when)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (toUpper)
 import Data.Maybe (fromJust)
@@ -238,8 +238,10 @@ confirmCreatePlayerC = Controller
     case ynHandler e of
       Just True  -> do
         modify addPlayer
-        join $ gets (view $ progMode.createPlayerStateL.cpsSuccessCallback)
-      Just False -> join $ gets (view $ progMode.createPlayerStateL.cpsFailureCallback)
+        gets (view $ progMode.createPlayerStateL.cpsSuccessCallback)
+          >>= modify
+      Just False -> gets (view $ progMode.createPlayerStateL.cpsFailureCallback)
+        >>= modify
       Nothing    -> return ()
     return True
   }

src/Mtlstats/Types.hs

@@ -210,9 +210,9 @@ data CreatePlayerState = CreatePlayerState
   -- ^ The player's name
   , _cpsPosition        :: String
   -- ^ The player's position
-  , _cpsSuccessCallback :: Action ()
+  , _cpsSuccessCallback :: ProgState -> ProgState
   -- ^ The function to call on success
-  , _cpsFailureCallback :: Action ()
+  , _cpsFailureCallback :: ProgState -> ProgState
   -- ^ The function to call on failure
   }
 
@@ -487,8 +487,8 @@ newCreatePlayerState = CreatePlayerState
   { _cpsNumber          = Nothing
   , _cpsName            = ""
   , _cpsPosition        = ""
-  , _cpsSuccessCallback = return ()
-  , _cpsFailureCallback = return ()
+  , _cpsSuccessCallback = id
+  , _cpsFailureCallback = id
   }
 
 -- | Constructor for a 'Database'