{-# LANGUAGE OverloadedStrings #-}

module Prettyprinter.Ext ( (<#>)
                         , PS (..)
                         , parensp
                         , prettyLines
                         , tupledBy
                         , ptxt
                         , aText
                         , prettyDumpBinds
                         , pAD
                         ) where

import           Data.Bits                 (Bits (..))
import qualified Data.IntMap               as IM
import qualified Data.Text                 as T
import           Data.Word                 (Word64)
import           Numeric                   (showHex)
import           Prettyprinter             (Doc, LayoutOptions (..), PageWidth (AvailablePerLine), Pretty (..), SimpleDocStream, concatWith, encloseSep, flatAlt, group, hardline,
                                            layoutSmart, parens, vsep, (<+>))
import           Prettyprinter.Render.Text (renderStrict)

infixr 6 <#>
(<#>) :: Doc a -> Doc a -> Doc a
<#> :: forall a. Doc a -> Doc a -> Doc a
(<#>) Doc a
x Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
hardline Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y

class PS a where
    ps :: Int -> a -> Doc ann

parensp :: Bool -> Doc ann -> Doc ann
parensp Bool
True=Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens; parensp Bool
False=Doc ann -> Doc ann
forall a. a -> a
id

prettyLines :: [Doc ann] -> Doc ann
prettyLines :: forall ann. [Doc ann] -> Doc ann
prettyLines = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
(<#>)

tupledBy :: Doc ann -> [Doc ann] -> Doc ann
tupledBy :: forall ann. Doc ann -> [Doc ann] -> Doc ann
tupledBy Doc ann
sep = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep (Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
flatAlt Doc ann
"( " Doc ann
"(") (Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
flatAlt Doc ann
" )" Doc ann
")") Doc ann
sep

appleLO :: LayoutOptions
appleLO :: LayoutOptions
appleLO = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
180 Double
1.0)

smartA :: Doc a -> SimpleDocStream a
smartA :: forall a. Doc a -> SimpleDocStream a
smartA = LayoutOptions -> Doc a -> SimpleDocStream a
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
appleLO

aText :: Doc a -> T.Text
aText :: forall a. Doc a -> Text
aText = SimpleDocStream a -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict(SimpleDocStream a -> Text)
-> (Doc a -> SimpleDocStream a) -> Doc a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Doc a -> SimpleDocStream a
forall a. Doc a -> SimpleDocStream a
smartA

ptxt :: Pretty a => a -> T.Text
ptxt :: forall a. Pretty a => a -> Text
ptxt = Doc Any -> Text
forall a. Doc a -> Text
aText(Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Doc Any
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

prettyBind :: (Pretty c, Pretty b) => (c, b) -> Doc a
prettyBind :: forall c b a. (Pretty c, Pretty b) => (c, b) -> Doc a
prettyBind (c
i, b
j) = c -> Doc a
forall ann. c -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty c
i Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
"→" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> b -> Doc a
forall ann. b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty b
j

prettyDumpBinds :: Pretty b => IM.IntMap b -> Doc a
prettyDumpBinds :: forall b a. Pretty b => IntMap b -> Doc a
prettyDumpBinds IntMap b
b = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ((Int, b) -> Doc a
forall c b a. (Pretty c, Pretty b) => (c, b) -> Doc a
prettyBind ((Int, b) -> Doc a) -> [(Int, b)] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap b -> [(Int, b)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap b
b)

hex2 :: Integral a => a -> Doc ann
hex2 :: forall a ann. Integral a => a -> Doc ann
hex2 a
i | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
16 = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$String
"")((String -> String) -> String)
-> (a -> String -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)((String -> String) -> String -> String)
-> (a -> String -> String) -> a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String -> String
forall a. Integral a => a -> String -> String
showHex) a
i)
       | Bool
otherwise = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$String
"")((String -> String) -> String)
-> (a -> String -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String -> String
forall a. Integral a => a -> String -> String
showHex) a
i)

-- FIXME: this is certainly wrong for arm/endianness
pAD :: IntMap (t Word64) -> Doc ann
pAD IntMap (t Word64)
ds = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((\(Int
n,t Word64
dd) -> Doc ann
"arr_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
".8byte" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"," Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y) ((Word64 -> Doc ann) -> t Word64 -> t (Doc ann)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Doc ann
forall ann. Word64 -> Doc ann
p64 t Word64
dd)) ((Int, t Word64) -> Doc ann) -> [(Int, t Word64)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (t Word64) -> [(Int, t Word64)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap (t Word64)
ds)

p64 :: Word64 -> Doc ann
p64 :: forall ann. Word64 -> Doc ann
p64 Word64
w = Doc ann
"0x"Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>Word64 -> Doc ann
forall a ann. Integral a => a -> Doc ann
hex2 Word64
w3Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>Word64 -> Doc ann
forall a ann. Integral a => a -> Doc ann
hex2 Word64
w2Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>Word64 -> Doc ann
forall a ann. Integral a => a -> Doc ann
hex2 Word64
w1Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>Word64 -> Doc ann
forall a ann. Integral a => a -> Doc ann
hex2 Word64
w0
    where w0 :: Word64
w0=Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffff; w1 :: Word64
w1=(Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xffff0000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateR` Int
16; w2 :: Word64
w2=(Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFF00000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateR` Int
32; w3 :: Word64
w3=(Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFF000000000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateR` Int
48