"Log in", extract number from a map, increment it, and log out

Question

Basically, you just run main and it allows the client to "log in", and extract their number from a map, increment their own number, and log out.

It all compiles and works fine, but how can I decouple this code, and make it more composable? I'm finding it's difficult to separate concerns, ex between the logic, and the IO + State effects.

What would be a better, more idiomatic way to right this, which would allow me to add features, such as a password, or decrement option?

Possible Actions: login <ENTER> name, inc, get, logout

{-# LANGUAGE FlexibleContexts #-}
import System.IO
import Data.Map
import Control.Monad.State
import Control.Lens.Tuple
import Control.Lens.Setter
import Control.Lens.Getter
import Prelude hiding (lookup) -- Data.Map has one I want
-- Features:
-- User can login, see their number, increment it ad lib, and log out
--
-- login
-- new username --> new map entry
-- old username --> display map entry
-- inc - increment current user's entry in map
-- logout - empties the current username
-- stop - close IO
-- bad input - just ask for another action
type DB = Map String Int
type Username = String
type AppState = (Username, DB)
db = fromList [("a", 0),
 ("b", 99),
 ("c", 152)] :: DB
-- increment a key in a map
incDB :: String -> DB -> DB
incDB k = (update (\x -> Just (x + 1)) k)
-- λ> inc "a" $ inc "a" $ inc "a" db
-- increment current user in a State Monad
-- (Num a, Ord k, MonadState (k, (Map k a)) m) => m x
incUser :: (MonadState AppState m) => m ()
incUser = do user <- gets $ view _1
 modify $ over _2 (incDB user)
-- λ> runState incUser ("b", db)
-- 1. update logged-in user name, 2. add new entry to db if it's a new user
login :: (MonadState AppState m) => String -> m ()
login newuser = do modify $ set _1 newuser
 modify $ over _2 $ insertWithKey (\k new old -> old) newuser 0 -- inserts new user if necessary
-- λ> runState (login "d") ("", db)
-- ((),("d",fromList [("a",0),("b",99),("c",152),("d",0)]))
-- get the number of the currently-logged-in user
getNum ::(MonadState AppState m) => m (Maybe Int)
getNum = do user <- gets $ view _1
 db <- gets $ view _2
 return $ lookup user db
-- λ> runState (do login "b"; incState; getNum) ("", db)
-- (Just 100,("b",fromList [("a",0),("b",100),("c",152)]))
-- remove the currently logged-in user from the appstate (not the db though, of course)
logout :: (MonadState AppState m) => m ()
logout = modify $ set _1 ""
-- λ> runState (do login "b"; getNum; logout ) ("", db)
-- ((),("",fromList [("a",0),("b",99),("c",152)]))
-- λ> runState (do login "b"; incUser; incUser; logout ) ("", db)
-- ((),("",fromList [("a",0),("b",101),("c",152)]))
run :: StateT AppState IO ()
run = do liftIO $ putStr "next action: "
 liftIO $ hFlush stdout
 action <- liftIO $ getLine
 case action of
 "inc" -> do incUser
 "login" -> do liftIO $ putStr "enter username:"
 user <- liftIO $ getLine
 login user
 "get" -> do n <- getNum
 liftIO $ putStr $ "current num: " ++ (show n) ++ "\n"
 -- liftIO $ hFlush stdout
 "logout" -> logout
 otherwise -> return ()
 if action == "stop"
 then
 return ()
 else
 run
main = do execStateT run ("", db)

Answer 1

I would inline, eta-reduce and use more library functions to make the code short enough that adding another command is trivial. Perhaps give the fields names so adding another can't mess up numbering, and you need less comments because the code describes itself.

Edit: I'll use non, making the map not add a value for new users until they want to change it. This way we don't need to initialize with db . at user %= (<|> Just 0) on logging in, and we can get rid of the Just returned by the "get" action without needing to promise we already initialized. (Which we don't necessarily have, as the initial ""!)

{#- LANGUAGE TemplateHaskell, LambdaCase -#}
import Control.Lens -- batteries included
import Control.Monad.Trans.Maybe
import Control.Applicative -- (<$>), (<*>), empty, (<|>)
import qualified Data.Map as M -- Data.Map's name collisions with prelude are customarily handled by qualification
data AppState = AppState
 { _appStateUsername :: String
 , _appStateDb :: M.Map String Int
 }
makeFields ''AppState
-- Here's one we can actually outline, because it's used more than once, and it allows us to pull out the liftIO, and it shows us that we forgot the hFlush and the trailing ' ' one of the times.
prompt :: MonadIO m => String -> m String
prompt s = liftIO $ do
 putStr $ s ++ ": "
 hFlush stdout
 getLine
main = runMaybeT $ (`execStateT` AppState "" M.empty) $ forever $ do
 prompt "next action" >>= \case
 "inc" -> do
 user <- use username
 db . at user . non 0 += 1
 "login" -> do
 user <- prompt "enter username"
 username .= user
 "get" -> do
 n <- M.findWithDefault 0 <$> use username <*> use db
 liftIO $ putStrLn $ "current num: " ++ show n -- Note that this includes the Maybe, even though at this point we're always just, unless we're still the initial "".
 "logout" -> do
 username .= "" -- Note that this makes for shenanigans if someone logs in as "".
 "stop" -> empty -- MaybeT helps us out with the control flow to get rid of the special case and recursion.
 _ -> liftIO $ putStrLn $ "usage: ehhh just look at the code mmkay"