    {-# 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 :: HasCallStack => 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 :: forall ann. 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 :: forall ann. 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 :: forall a. Pretty a => a -> Doc ()
    fromPretty = Doc (ZonkAny 0) -> Doc ()
    forall ann. Doc ann -> Doc ()
    removeAnnotations (Doc (ZonkAny 0) -> Doc ())
    -> (a -> Doc (ZonkAny 0)) -> a -> Doc ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Doc (ZonkAny 0)
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty