Simplifying ExceptT code - Haskell

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Sridhar Ratnakumar

I came up with this, just to make it work, but it looks rather complex. Now figuring out how to simplify it ...

mkDocumentFrom (Arg k) (Arg f) = runExceptT $ do
  -- HACK: this looks bad
  v :: repr <-
    liftEither
      =<< ( lift $ fmap (first DocumentError_MarkupError) $
              readDoc @repr @b
                ! #relpath k
                ! #path f
          )
  h <- withExceptT DocumentError_MarkupError $ liftEither $ renderDoc v
  let metaValueM = extractMeta v
  metaValue <- maybeToEither DocumentError_MetadataMissing metaValueM
  meta <-
    withExceptT DocumentError_MetadataBadJSON
      $ liftEither
      $ resultToEither
      $ fromJSON metaValue
  pure $ Document k v h metaValueM meta
  where
    maybeToEither e = \case
      Nothing -> throwError e
      Just v -> pure v
    resultToEither = \case
      Error e -> Left e
      Success v -> Right v
Sridhar Ratnakumar

Improved it to this. Still not sure if I'm happy:

mkDocumentFrom ::
  forall m b repr meta.
  (MonadError (DocumentError repr) m, MonadIO m, Markup repr, FromJSON meta) =>
  -- | File path, used only to identify (not access) the document
  "relpath" :! Path Rel File ->
  -- | Actual file path, for access and reading
  "path" :! Path b File ->
  m (Document repr meta)
mkDocumentFrom (Arg k) (Arg f) = do
  v <-
    liftEither . first DocumentError_MarkupError
      =<< liftIO (readDoc ! #relpath k ! #path f)
  html <-
    liftEither
      $ first DocumentError_MarkupError
      $ renderDoc v
  let metaValueM = extractMeta v
  metaValue <-
    metaValueM
      & maybeToEither DocumentError_MetadataMissing
  meta <-
    liftEither
      $ first DocumentError_MetadataBadJSON
      $ resultToEither
      $ fromJSON metaValue
  pure $ Document k v html metaValueM meta
  where
    maybeToEither e = \case
      Nothing -> throwError e
      Just v -> pure v
    resultToEither = \case
      Error e -> Left e
      Success v -> Right v
Sridhar Ratnakumar

@Fintan Halpenny Good to know about it! I use relude as my prelude, and wonder why they don't already have these useful functions ...

Sridhar Ratnakumar

Wait, they do already have maybeToRight, and I can define mine as maybeToEither e = liftEither . maybeToRight e

Sridhar Ratnakumar
mkDocumentFrom k@(arg #relpath -> k') f = do
  v <-
    liftEither . first DocumentError_MarkupError
      =<< readDoc k f
  html <-
    liftEither . first DocumentError_MarkupError $
      renderDoc v
  metaValue <-
    liftEither . (first DocumentError_MetadataMalformed)
      =<< maybeToEither DocumentError_MetadataMissing (extractMeta v)
  meta <-
    liftEither . first (DocumentError_MetadataMalformed . toText) $
      resultToEither (fromJSON metaValue)
  pure $ Document k' v html meta
  where
    maybeToEither e = liftEither . maybeToRight e
    resultToEither = \case
      Error e -> Left e
      Success v -> Right v
Fintan Halpenny
    liftEither . (first DocumentError_MetadataMalformed)
      =<< maybeToEither DocumentError_MetadataMissing (extractMeta v)

This looks a bit strange. Could it be simplified to?:

maybeToEither (DocumentError_MetadataMalformed DocumentError_MetadataMissing) (extractMeta v)
Sridhar Ratnakumar

Not sure how I'd simplify it further. See here for full context: https://github.com/srid/rib/blob/master/src/Rib/Document.hs#L75-L115

Haskell library for writing your own static site generator - srid/rib
Sridhar Ratnakumar

The extractMeta returns a Maybe (Either e a). We want to apply the Missing error for Nothing, and the Malformed error for the inner Left

Fintan Halpenny

Ah that makes more sense! I was reading the types wrong :)