{-# LANGUAGE ScopedTypeVariables #-}

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