{-
    BNF Converter: Haskell error monad
    Copyright (C) 2004-2007  Author:  Markus Forsberg, Peter Gammie,
                                      Aarne Ranta, Björn Bringert
    Copyright (C) 2019 Author: Andreas Abel

-}

{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Haskell.MkErrM where

import BNFC.PrettyPrint

mkErrM :: String -> Doc
mkErrM :: String -> Doc
mkErrM String
errMod = [Doc] -> Doc
vcat
    [ Doc
"{-# LANGUAGE CPP #-}"
    , Doc
""
    , Doc
"-- | BNF Converter: Error Monad."
    , Doc
"--"
    , Doc
"-- Module for backwards compatibility."
    , Doc
"--"
    , Doc
"-- The generated parser now uses @'Either' String@ as error monad."
    , Doc
"-- This module defines a type synonym 'Err' and pattern synonyms"
    , Doc
"-- 'Bad' and 'Ok' for 'Left' and 'Right'."
    , Doc
""
    , Doc
"{-# LANGUAGE PatternSynonyms #-}"
    , Doc
"{-# LANGUAGE FlexibleInstances #-}"
    , Doc
""
    , Doc
"module" Doc -> Doc -> Doc
<+> String -> Doc
text String
errMod Doc -> Doc -> Doc
<+> Doc
"where"
    , Doc
""
    , Doc
"import Prelude             (id, const, Either(..), String)"
    , Doc
""
    , Doc
"import Control.Monad       (MonadPlus(..))"
    , Doc
"import Control.Applicative (Alternative(..))"
    , Doc
"#if __GLASGOW_HASKELL__ >= 808"
    , Doc
"import Control.Monad       (MonadFail(..))"
    , Doc
"#endif"
    , Doc
""
    , Doc
"-- | Error monad with 'String' error messages."
    , Doc
"type Err = Either String"
    , Doc
""
    , Doc
"pattern Bad msg = Left msg"
    , Doc
"pattern Ok  a   = Right a"
    , Doc
""
    , Doc
"#if __GLASGOW_HASKELL__ >= 808"
    , Doc
"instance MonadFail Err where"
    , Doc
"  fail = Bad"
    , Doc
"#endif"
    , Doc
""
    , Doc
"instance Alternative Err where"
    , Doc
"  empty           = Left \"Err.empty\""
    , Doc
"  (<|>) Left{}    = id"
    , Doc
"  (<|>) x@Right{} = const x"
    , Doc
""
    , Doc
"instance MonadPlus Err where"
    , Doc
"  mzero = empty"
    , Doc
"  mplus = (<|>)"
    ]