Search code examples
monadsmonad-transformerspurescript

How to create a custom parser Monad for SimpleJSON in PureScript?


I have the following, which works up until the point I try to define readJSON':

newtype JSONWithErr a = JSONWithErr (Writer (Array Foreign.ForeignError) a)

derive newtype instance jsonWithErrApply :: Apply JSONWithErr
derive newtype instance jsonWithErrApplicative :: Applicative JSONWithErr
derive newtype instance jsonWithErrFunctor :: Functor JSONWithErr
derive newtype instance jsonWithErrBind :: Bind JSONWithErr
derive newtype instance jsonWithErrMonad :: Monad JSONWithErr
derive newtype instance jsonWithErrTell :: MonadTell (Array Foreign.ForeignError) JSONWithErr
derive newtype instance jsonWithErrWriter :: MonadWriter (Array Foreign.ForeignError) JSONWithErr

newtype JSONParse a = JSONParse (ExceptT (NonEmptyList ForeignError) JSONWithErr a)

derive newtype instance jsonParseApply :: Apply JSONParse
derive newtype instance jsonParseApplicative :: Applicative JSONParse
derive newtype instance jsonParseFunctor :: Functor JSONParse
derive newtype instance jsonParseBind :: Bind JSONParse
derive newtype instance jsonParseMonad :: Monad JSONParse
derive newtype instance jsonParseTell :: MonadTell (Array Foreign.ForeignError) JSONParse
derive newtype instance jsonParseWriter :: MonadWriter (Array Foreign.ForeignError) JSONParse
derive newtype instance jsonParseThrow :: MonadThrow (NonEmptyList ForeignError) JSONParse

generalize :: forall m a. Monad m => Identity a -> m a
generalize = unwrap >>> pure

-- type Except e = ExceptT e Identity
genExcept :: forall m e a. Monad m => ExceptT e Identity a -> ExceptT e m a
genExcept = unwrap >>> generalize >>> ExceptT

readJSON' :: forall a. JSON.ReadForeign a => String -> JSONParse a
readJSON' s = JSONParse $ genExcept $ (pure >>> JSONWithErr) <$> (JSON.readJSON' s) -}

The error here, which covers the entire definition of readJSON', is:

Could not match type

    JSONWithErr t2

  with type

    a0


while trying to match type JSONParse t1
  with type JSONParse a0
while checking that expression (apply JSONParse) ((apply genExcept) ((map (...)) (readJSON' s)))
  has type JSONParse a0
in value declaration readJSON'

where a0 is a rigid type variable
        bound at (line 0, column 0 - line 0, column 0)
      t1 is an unknown type
      t2 is an unknown type

I've tried to simplify it a bit, but I seem to run into issues with constraints; in the following simplification, the typed hole doesn't work because of an earlier error:

tmp :: forall a. JSON.ReadForeign a => String -> ExceptT (NonEmptyList ForeignError) JSONWithErr a
tmp s = ?help (JSON.readJSON' s)

And the error:

  No type class instance was found for

    Simple.JSON.ReadForeign t0

  The instance head contains unknown type variables. Consider adding a type annotation.

while applying a function readJSON'
  of type ReadForeign t0 => String -> ExceptT (NonEmptyList ForeignError) Identity t0
  to argument s
while inferring the type of readJSON' s
in value declaration tmp

Solution

  • I think you just got tangled in your own cleverness.

    Take a look at what type of argument genExcept expects: ExceptT e Identity a, but you can also tell that e ~ (NonEmptyList ForeignError), because the result of genExcept gets later wrapped in JSONParse

    So the type of argument that genExcept expects, as instantiated in the body of readJSON', is ExceptT (NonEmptyList ForeignError) Identity a, for which there is a handy type alias - F.

    So we can tell that it must be:

    (pure >>> JSONWithErr) <$> (JSON.readJSON' s) :: F a
    

    But look at the return type of JSON.readJSON':

    readJSON' :: forall a. ReadForeign a => String -> F a
    

    So JSON.readJSON' s is already of type F a

    And then you're wrapping it in some pure, and then in JSONWithErr, so the whole expression becomes:

    (pure >>> JSONWithErr) <$> (JSON.readJSON' s) :: F (JSONWithErr (b a))
    

    for some b determined by pure.

    Which is not what genExcept expects. So quite naturally you get an error.

    From what I can assume about your ultimate intentions, it seems that you can pass JSON.readJSON' s directly to genExcept, and the types will work out:

    readJSON' :: forall a. JSON.ReadForeign a => String -> JSONParse a
    readJSON' s = JSONParse $ genExcept $ JSON.readJSON' s