{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}

module Clash.Pretty where

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Render.String
#else
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.String
#endif

import Data.Maybe (fromMaybe)
import qualified System.Console.Terminal.Size as Terminal
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (readMaybe)
import qualified Clash.Util.Interpolate as I
import GHC.Stack (HasCallStack)

unsafeLookupEnvWord :: HasCallStack => String -> Word -> Word
unsafeLookupEnvWord :: String -> Word -> Word
unsafeLookupEnvWord String
key Word
dflt =
  case IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (String -> IO (Maybe String)
lookupEnv String
key) of
    Maybe String
Nothing -> Word
dflt
    Just String
w -> (Word -> Maybe Word -> Word) -> Maybe Word -> Word -> Word
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe Word
forall a. Read a => String -> Maybe a
readMaybe String
w) (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ String -> Word
forall a. HasCallStack => String -> a
error [I.i|
      'unsafeLookupEnvWord' tried to lookup #{key} in the environment. It found
      it, but couldn't interpret it to as a Word (positive Int). Found:

        #{w}
    |]

defaultPprWidth :: Int
defaultPprWidth :: Int
defaultPprWidth =
  let dflt :: Word
dflt = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
80 (Word -> (Window Word -> Word) -> Maybe (Window Word) -> Word
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word
80 Window Word -> Word
forall a. Window a -> a
Terminal.width (IO (Maybe (Window Word)) -> Maybe (Window Word)
forall a. IO a -> a
unsafePerformIO IO (Maybe (Window Word))
forall n. Integral n => IO (Maybe (Window n))
Terminal.size)) in
  Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => String -> Word -> Word
String -> Word -> Word
unsafeLookupEnvWord String
"CLASH_PPR_WIDTH" Word
dflt)

showDoc :: Doc ann -> String
showDoc :: Doc ann -> String
showDoc =
  let layoutOpts :: LayoutOptions
layoutOpts = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
defaultPprWidth Double
0.6) in
  SimpleDocStream ann -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream ann -> String)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layoutOpts

removeAnnotations :: Doc ann -> Doc ()
removeAnnotations :: Doc ann -> Doc ()
removeAnnotations = (ann -> ()) -> Doc ann -> Doc ()
forall ann ann'. (ann -> ann') -> Doc ann -> Doc ann'
reAnnotate ((ann -> ()) -> Doc ann -> Doc ())
-> (ann -> ()) -> Doc ann -> Doc ()
forall a b. (a -> b) -> a -> b
$ () -> ann -> ()
forall a b. a -> b -> a
const ()

-- | A variant of @Pretty@ that is not polymorphic on the type of annotations.
-- This is needed to derive instances from Clash's pretty printer (PrettyPrec),
-- which annotates documents with Clash-specific information and, therefore,
-- fixes the type of annotations.
class ClashPretty a where
  clashPretty :: a -> Doc ()

fromPretty :: Pretty a => a -> Doc ()
fromPretty :: a -> Doc ()
fromPretty = Doc Any -> Doc ()
forall ann. Doc ann -> Doc ()
removeAnnotations (Doc Any -> Doc ()) -> (a -> Doc Any) -> a -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty