-- This adapts definitions found in src/comp/PPrint.hs and src/comp/Pretty.hs
-- in bsc.
module Language.Bluespec.Pretty
  ( PDetail
  , pdReadable
  , pdAll
  , pdDebug
  , pdMark
  , pdInfo
  , pdNoqual

  , ppReadable
  , ppReadableIndent
  , ppAll
  , ppDebug

  , pparen
  , sepList
  , ppr
  , maxPrec

  , s2par
  ) where

import Text.PrettyPrint.HughesPJClass

import Language.Bluespec.Prelude

type PDetail = PrettyLevel

pdReadable :: PDetail
pdReadable :: PDetail
pdReadable = Int -> PDetail
PrettyLevel Int
1

pdAll :: PDetail
pdAll :: PDetail
pdAll = Int -> PDetail
PrettyLevel Int
2

pdDebug :: PDetail
pdDebug :: PDetail
pdDebug = Int -> PDetail
PrettyLevel Int
3

pdMark :: PDetail
pdMark :: PDetail
pdMark = Int -> PDetail
PrettyLevel Int
4

pdInfo :: PDetail
pdInfo :: PDetail
pdInfo = Int -> PDetail
PrettyLevel Int
5

pdNoqual :: PDetail
pdNoqual :: PDetail
pdNoqual = Int -> PDetail
PrettyLevel Int
6

ppReadable :: Pretty a => a -> String
ppReadable :: forall a. Pretty a => a -> String
ppReadable = PDetail -> a -> String
forall a. Pretty a => PDetail -> a -> String
ppr PDetail
pdReadable

ppReadableIndent :: Pretty a => Int -> a -> String
ppReadableIndent :: forall a. Pretty a => Int -> a -> String
ppReadableIndent Int
i = Int -> PDetail -> a -> String
forall a. Pretty a => Int -> PDetail -> a -> String
pprIndent Int
i PDetail
pdReadable

ppAll :: Pretty a => a -> String
ppAll :: forall a. Pretty a => a -> String
ppAll = PDetail -> a -> String
forall a. Pretty a => PDetail -> a -> String
ppr PDetail
pdAll

ppDebug :: Pretty a => a -> String
ppDebug :: forall a. Pretty a => a -> String
ppDebug = PDetail -> a -> String
forall a. Pretty a => PDetail -> a -> String
ppr PDetail
pdDebug

pparen :: Bool -> Doc -> Doc
pparen :: Bool -> Doc -> Doc
pparen Bool
False Doc
x = Doc
x
pparen Bool
True  Doc
x = String -> Doc
textString
"(" Doc -> Doc -> Doc
<> Doc
x Doc -> Doc -> Doc
<> String -> Doc
textString
")"

sepList :: [Doc] -> Doc -> Doc
sepList :: [Doc] -> Doc -> Doc
sepList [] Doc
_ = Doc
empty
sepList [Doc]
xs Doc
s = [Doc] -> Doc
sep ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Doc
x->Doc
x Doc -> Doc -> Doc
<> Doc
s) ([Doc] -> [Doc]
forall a. HasCallStack => [a] -> [a]
init [Doc]
xs) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Doc] -> Doc
forall a. HasCallStack => [a] -> a
last [Doc]
xs])

maxPrec :: Int
maxPrec :: Int
maxPrec = Int
20

ppr :: Pretty a => PDetail -> a -> String
ppr :: forall a. Pretty a => PDetail -> a -> String
ppr PDetail
d = Int -> Int -> Doc -> String
pretty Int
lineWidth Int
linePref (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDetail -> Rational -> a -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
d Rational
0

pprIndent :: Pretty a => Int -> PDetail -> a -> String
pprIndent :: forall a. Pretty a => Int -> PDetail -> a -> String
pprIndent Int
i PDetail
d = Int -> Int -> Doc -> String
pretty Int
lineWidth Int
linePref (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
nest Int
i (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDetail -> Rational -> a -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
d Rational
0

lineWidth, linePref :: Int
lineWidth :: Int
lineWidth = Int
120
linePref :: Int
linePref = Int
100

-- Produces a string from a text "x" in Normal mode with "w" line
-- length, "w/m" ribbons per line.
pretty :: Int -> Int -> Doc -> String
pretty :: Int -> Int -> Doc -> String
pretty Int
w Int
m Doc
x = Mode
-> Int
-> Float
-> (TextDetails -> String -> String)
-> String
-> Doc
-> String
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender Mode
PageMode Int
w (Int -> Float
forall a. Enum a => Int -> a
toEnum Int
w Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a. Enum a => Int -> a
toEnum Int
m) TextDetails -> String -> String
string_txt String
"\n" Doc
x

-- The function which tells fullRender how to compose Doc elements
-- into a String.
string_txt :: TextDetails -> String -> String
string_txt :: TextDetails -> String -> String
string_txt (Chr Char
c)   String
s  = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
s
string_txt (Str String
s1)  String
s2 = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2
string_txt (PStr String
s1) String
s2 = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2

-- Pretty printing utilities

-- Creates a paragraph
s2par :: String -> Doc
s2par :: String -> Doc
s2par String
str = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text (String -> [String]
words String
str)