module Text.Roundtrip.SpecPrinter (
SpecPrinter, specPrinter, runSpecPrinter
) where
import Prelude hiding (catch)
import Control.Exception (AsyncException, catch)
import qualified Data.Text.Lazy as TL
import Text.PrettyPrint.HughesPJ
import Control.Isomorphism.Partial
import Text.Roundtrip hiding (text, (<+>))
newtype SpecPrinter a = SpecPrinter { unSpecPrinter :: Doc }
specPrinter :: Doc -> SpecPrinter a
specPrinter = SpecPrinter
instance IsoFunctor SpecPrinter where
iso <$> (SpecPrinter p) = SpecPrinter $ text (isoName iso) <+> text "<$>" <+> p
instance ProductFunctor SpecPrinter where
(SpecPrinter p) <*> (SpecPrinter q) =
SpecPrinter $ parens (p <+> text "<*>" <+> q)
instance Alternative SpecPrinter where
(SpecPrinter p) <|> (SpecPrinter q) =
SpecPrinter $ parens (p <+> text "<|>" <+> q)
(SpecPrinter p) <||> (SpecPrinter q) =
SpecPrinter $ parens (p <+> text "<||>" <+> q)
empty = SpecPrinter $ text "empty"
instance Syntax SpecPrinter where
pure _ = SpecPrinter $ text "pure"
rule name (SpecPrinter p) _ = SpecPrinter $ text name <+> p
ruleInfix name (SpecPrinter p) (SpecPrinter q) _ = SpecPrinter $ p <+> text name <+> q
runSpecPrinter :: SpecPrinter a -> String
runSpecPrinter (SpecPrinter p) = render p