module BNFC.Backend.Common.Utils where import BNFC.Prelude import Prettyprinter import Prettyprinter.Render.String -- | The name of a module, e.g. "Foo.Abs", "Foo.Print" etc. type ModuleName = String -- | Generalization of 'Control.Monad.unless'. unless :: Monoid m => Bool -> m -> m unless False m = m unless True _ = mempty -- | Generalization of 'Control.Monad.when'. when :: Monoid m => Bool -> m -> m when True m = m when False _ = mempty prPrec :: Int -> Int -> Doc () -> Doc () prPrec i j d = if i > j then parens d else d docToString :: LayoutOptions -> Doc () -> String docToString layoutOpts = renderString . layoutSmart layoutOpts -- | Replace all occurences of a value by another value replace :: (Eq a, Functor f) => a -- ^ Value to replace -> a -- ^ Value to replace it with -> f a -> f a replace x y xs = (\z -> if z == x then y else z) <$> xs