Hi,
First of all I’m super noob with PureScript (fp in general).
My terrible looking function
I was hacking away an Expressjs app without worrying to much on how it looked like as long as I could get going, this is the function:
createListing :: Handler
createListing = do
env <- liftEffect $ getConfig
body <- getBody >>= runExcept >>> pure
maybeToken :: Maybe Admin.DecodedIdToken <- getUserData "idToken"
case body, env, maybeToken of
Left e, _, _ -> do
logShow e
setStatus 400
sendJson { error: "the body is malformed" }
Right _, Left e, _ -> do
logShow e
setStatus 500
sendJson { error: "something happend 1" }
Right _, Right _, Nothing -> do
logShow "no token"
setStatus 500
sendJson { error: "something happend 2" }
Right (a :: CreateListingForm), Right config, Just token -> do
logShow a
eitherSummoner <- liftAff $ RS.summonersByName config a.summonerName
case eitherSummoner of
Left err -> do
log $ "1 GET /api response failed to decode: " <> show err
setStatus 500
sendJson { error: "something happend 3" }
Right summoner -> do
result <- liftAff $ getLeagueEntriesForSummoner config summoner.id
case result of
Right leagueEntries ->
do
leagueEntries
# find
( case _ of
LOL entry ->
entry.queueType == "RANKED_SOLO_5x5"
_ -> false
)
# case _ of
Just (LOL leagueEntry) -> do
isRegistered <- liftAff $ summonerExists summoner
logShow isRegistered
if isRegistered then do
setStatus 403
sendJson { error: "summoner already has an entry" }
else do
id <- liftEffect UUID.genUUID
let
entry =
{ id: id
, userUUID: token.uid
, summonerName: summoner.name
, queueType: a.queueType
, tier: leagueEntry.tier
, rank: leagueEntry.rank
-- , lanes: []
-- , note: ""
, profileIconId: summoner.profileIconId
, wins: leagueEntry.wins
, losses: leagueEntry.losses
}
resp <- liftAff $ try $ writeEntry entry
case resp of
Left e -> do
logShow e
setStatus 500
sendJson { error: "something happend 5" }
Right _ -> do
-- log $ "GET /api response: " <> stringify response.body
sendJson entry
_ -> do
-- TODO: this is just an unranked player or not ranked in that particular thing
log $ "no stats for queue type" <> show leagueEntries
setStatus 500
sendJson { error: "something happend 4" }
Left err -> do
log $ "2 GET /api response failed to decode: " <> show err
logShow summoner
setStatus 500
sendJson { error: "something happend 6" }
But the nesting is terrible looking, and the match expression is quite repetitive.
I tried to use Aff Either and stay in the Aff as long as possible before coming up to the Handler again.
After A LOT of refactoring (for the purpose of 
learning ) I came up with this:
Refactor N1
maybeToken
# note NoToken
>>=
( \token ->
env
# bimap (EnvError) (\env' -> { token, env' })
)
>>=
( \prev ->
body
# bimap MalformedBody (\body' -> merge prev { body' })
)
# pure
>>= case _ of
Right prev@{ env', body' } ->
RS.summonersByName env' body'.summonerName
>>=
bimap
SummonersByNameError
(\summoner -> merge prev { summoner })
>>> pure
Left x -> pure $ Left x
>>= case _ of
Right prev@{ env', summoner } ->
getLeagueEntriesForSummoner env' summoner.id
>>=
bimap
GetLeagueEntriesForSummonerError
(\leagueEntries -> merge prev { leagueEntries })
>>> pure
Left x -> pure $ Left x
>>= case _ of
Right prev@{ leagueEntries } ->
leagueEntries
# find
( case _ of
LOL entry ->
entry.queueType == "RANKED_SOLO_5x5"
_ -> false
)
# case _ of
Just (LOL leagueEntry) ->
Right $ merge prev { leagueEntry }
_ -> Left Unranked
# pure
Left x -> pure $ Left x
>>= case _ of
Right prev@{ token, body', leagueEntry, summoner } ->
summonerExists summoner
>>= \isRegistered -> do
id <- liftEffect UUID.genUUID
pure $
if isRegistered then Left SummonerExists
else
{ entry:
{ id: id
, userUUID: token.uid
, summonerName: summoner.name
, queueType: body'.queueType
, tier: leagueEntry.tier
, rank: leagueEntry.rank
, profileIconId: summoner.profileIconId
, wins: leagueEntry.wins
, losses: leagueEntry.losses
}
}
# merge prev
# Right
Left x -> pure $ Left x
>>= case _ of
Right prev@{ entry } ->
do
try $ writeEntry entry
>>=
case _ of
Left e -> Left (ErrorWriting (show e))
Right _ -> Right prev
>>> pure
Left x -> pure $ Left x
# liftAff
>>= case _ of
Left err@NoToken -> do
logShow err
setStatus 401
sendJson { error: "the token is malformed" }
Left err@(EnvError _) -> do
logShow err
setStatus 500
sendJson { error: "something happend 1" }
Left err@(MalformedBody _) -> do
logShow err
setStatus 400
sendJson { error: "the body is malformed" }
Left err@(SummonersByNameError _) -> do
logShow err
setStatus 500
sendJson { error: "something happend 3" }
Left err@(GetLeagueEntriesForSummonerError _) -> do
logShow err
setStatus 500
sendJson { error: "something happend 6" }
Left err@(Unranked) -> do
-- TODO: this is just an unranked player or not ranked in that particular thing
logShow err
setStatus 500
sendJson { error: "something happend 4" }
Left err@(SummonerExists) -> do
logShow err
setStatus 500
sendJson { error: "summoner already has an entry" }
Left err@(ErrorWriting _) -> do
logShow err
setStatus 500
sendJson { error: "something happend 6" }
Right { entry } -> do
sendJson entry
It is very intimidating, and the left side is very repetitive
I struggled with Aff(Either a b) having to case _ of in each step, looking for something like bindBind for a -> Aff(Either b c) -> Aff(Either b a) -> Aff(Either b c) but couldn’t figure it out. So I jumped to ExceptT as >>= seems to be closer to what I was looking for.
I refactored inline to ExceptT and then decided to try to use where to code split functions and finally arrived at this:
createListing :: Handler
createListing =
do
env <- liftEffect $ getConfig
(body :: Either MultipleErrors CreateListingForm) <- getBody >>= runExcept >>> pure
(token :: Maybe Admin.DecodedIdToken) <- getUserData "idToken"
tokenOrErr token
>>= envOrErr env
>>= bodyOrErr body
>>= summonerOrErr
>>= leagueEntriesOrErr
>>= findRankedSoloOrErr
>>= entryOrErr
>>= writeEntryOrErr
# runExceptT
# liftAff
>>= case _ of
Left (code /\ err) -> do
setStatus code
sendJson { error: err }
Right { entry } -> do
sendJson entry
where
tokenOrErr :: Maybe Admin.DecodedIdToken -> ExceptT CreateListingError Aff { token' :: Admin.DecodedIdToken }
tokenOrErr = note (401 /\ "the token is malformed") >>> map (\token' -> { token' }) >>> except
envOrErr
:: (Either JsonDecodeError Config)
-> { token' :: Admin.DecodedIdToken
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
}
envOrErr env prev = env
# bimap (const (500 /\ "something happend 1")) (\env' -> merge prev { env' })
# except
bodyOrErr
:: (Either MultipleErrors CreateListingForm)
-> { token' :: Admin.DecodedIdToken
, env' :: Config
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
}
bodyOrErr body prev = body
# bimap (const (400 /\ "the body is malformed")) (\body' -> (merge prev { body' }))
# except
summonerOrErr
:: { token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
}
summonerOrErr prev =
RS.summonersByName prev.env' prev.body'.summonerName
# lift
>>=
bimap
(const (500 /\ "something happend 3"))
(\summoner -> merge prev { summoner })
>>> except
leagueEntriesOrErr
:: { token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntries :: Array LeagueEntryDTO
}
leagueEntriesOrErr prev =
getLeagueEntriesForSummoner prev.env' prev.summoner.id
# lift
>>=
bimap
(const $ 500 /\ "something happend 6")
(\leagueEntries -> merge prev { leagueEntries })
>>> except
findRankedSoloOrErr
:: { token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntries :: Array LeagueEntryDTO
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntries :: Array LeagueEntryDTO
, leagueEntry :: LeagueEntryDTOLOL
}
findRankedSoloOrErr prev =
prev.leagueEntries
# find
( case _ of
LOL entry ->
entry.queueType == "RANKED_SOLO_5x5"
_ -> false
)
# case _ of
Just (LOL leagueEntry) ->
Right $ merge prev { leagueEntry }
_ -> Left (500 /\ "player is unranked")
# except
entryOrErr
:: { token' :: Admin.DecodedIdToken
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntry :: LeagueEntryDTOLOL
, leagueEntries :: Array LeagueEntryDTO
, env' :: Config
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntries :: Array LeagueEntryDTO
, leagueEntry :: LeagueEntryDTOLOL
, entry :: Entry
}
entryOrErr prev =
summonerExists prev.summoner
# lift
>>= \isRegistered -> do
id <- liftEffect UUID.genUUID
except $
if isRegistered then Left (500 /\ "summoner already has an entry")
else
{ entry:
{ id: id
, userUUID: prev.token'.uid
, summonerName: prev.summoner.name
, queueType: prev.body'.queueType
, tier: prev.leagueEntry.tier
, rank: prev.leagueEntry.rank
, profileIconId: prev.summoner.profileIconId
, wins: prev.leagueEntry.wins
, losses: prev.leagueEntry.losses
}
}
# merge prev
# Right
writeEntryOrErr
:: forall r
. { entry :: Entry
| r
}
-> ExceptT
CreateListingError
Aff
{ entry :: Entry
| r
}
writeEntryOrErr prev =
prev.entry
# writeEntry
# try
# lift
>>=
case _ of
Left _ -> Left (500 /\ "something happend 6")
Right _ -> Right prev
>>> except
I struggled a lot to make the main part concise
createListing :: Handler
createListing =
do
env <- liftEffect $ getConfig
(body :: Either MultipleErrors CreateListingForm) <- getBody >>= runExcept >>> pure
(token :: Maybe Admin.DecodedIdToken) <- getUserData "idToken"
tokenOrErr token
>>= envOrErr env
>>= bodyOrErr body
>>= summonerOrErr
>>= leagueEntriesOrErr
>>= findRankedSoloOrErr
>>= entryOrErr
>>= writeEntryOrErr
# runExceptT
# liftAff
>>= case _ of
Left (code /\ err) -> do
setStatus code
sendJson { error: err }
Right { entry } -> do
sendJson entry
Probably can be a lot better.
One of the remaining issues I have with the code is the size and repetition of these signatures:
entryOrErr
:: { token' :: Admin.DecodedIdToken
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntry :: LeagueEntryDTOLOL
, leagueEntries :: Array LeagueEntryDTO
, env' :: Config
}
-> ExceptT
CreateListingError
Aff
{ token' :: Admin.DecodedIdToken
, env' :: Config
, body' :: CreateListingForm
, summoner :: SummonerDTO
, leagueEntries :: Array LeagueEntryDTO
, leagueEntry :: LeagueEntryDTOLOL
, entry :: Entry
}
wish I could do something like:
writeEntryOrErr
:: forall r
. { entry :: Entry
| r
}
-> ExceptT
CreateListingError
Aff
{ entry :: Entry
| r
}
And restructure a row type for only the values I need at each step, but I use Record(merge) to return more data in all steps but the last one, so the types get a bit complicated, I have to use Union and Nub in the signature so merge doesn’t return an error. (However, if I just write in-line functions the type inference works perfectly).
Other Solutions: Writer / Reader
Another Solution I could think of is to use a Writer/Reader instead of passing a new record all the time, but that would make all the functions “fragile” I think, if they are not placed exactly right, types cannot say “you’re missing a value” and just go left.
What I can say about the last code
- types are long
- types are repetitive
- overall code is much more than the original messy version.
Is there a way to improve this code? I bet there is a myriad of things to do “better” but as I said, I’m not that savvy with PS/FP.
Thank you for your help 
