module Frenetic.NetCore.Pretty
( toString
, putNetCore
, putNetCoreLn
, hPutNetCore
) where
import Data.List
import qualified Data.MultiSet as MS
import Frenetic.NetCore.Short
import Frenetic.NetCore.Types
import System.IO
import Text.PrettyPrint.ANSI.Leijen
ribbonFrac = 0.8
lineWidth = 100
render = renderPretty ribbonFrac lineWidth
toString p = displayS (render $ prettyPo p) ""
putNetCore = hPutNetCore stdout
putNetCoreLn = hPutNetCoreLn stdout
hPutNetCore :: Handle -> Policy -> IO ()
hPutNetCore h p = do
let rendered = render $ prettyPo p
displayIO h rendered
hPutNetCoreLn h p = do
hPutNetCore h p
hPutChar h '\n'
prettyPr (PrPattern p) = prettyPattern " = " p
prettyPr (PrTo s) = text "switch = " <> integer (fromIntegral s)
prettyPr p@(PrUnion _ _) = text "Or " <>
(align . tupled . map prettyPr $ prUnUnion p)
prettyPr p@(PrIntersect _ _) = text "And " <>
(align . tupled . map prettyPr $ prUnIntersect p)
prettyPr (PrNegate p) = text "Not " <> align (tupled [prettyPr p])
prettyAc (Action fwds qs) =
(semiBraces . map prettyForward . MS.toAscList $ fwds) </>
text "emit " <>
(semiBraces . map (integer . fromIntegral . idOfQuery) . MS.toAscList $ qs)
prettyPo PoBottom = text "Bottom"
prettyPo (PoBasic pr ac) = prettyPr pr </> text " ==> " <> align (prettyAc ac)
prettyPo p = list (map prettyPo (poUnUnion p))
prettyPattern sep p = semiBraces . map text . interesting sep $ p
prettyForward (port, mods) = prettyPseudoPort port <> mods' where
mods' = if mods == unmodified then empty
else text " with " <> text (show mods)
prettyPseudoPort (Physical p) = text "Port " <> integer (fromIntegral p)
prettyPseudoPort AllPorts = text "AllPorts"