-- |
-- Module      : Data.Elf.PrettyPrint
-- Description : Pretty printing the data parsed by Data.Elf
-- Copyright   : (c) Aleksey Makarov, 2021
-- License     : BSD 3-Clause License
-- Maintainer  : aleksey.makarov@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- Pretty print the data parsed by @Data.Elf@.  Basically these functions are used for golden testing.

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Elf.PrettyPrint
    ( printHeaders
    , printLayout
    , printElf_
    , printElf
    , printStringTable
    , printHeader

    , readFileLazy
    , writeElfDump
    , writeElfLayout

    , splitBits
    ) where

import Control.Monad
import Control.Monad.Catch
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Data.Char
import Data.Int
import qualified Data.List as L
import Data.Word
import Numeric
import Prettyprinter
import Prettyprinter.Render.Text
import System.IO

import Control.Exception.ChainedException
import Data.Internal.Elf
import Data.Elf.Constants
import Data.Elf.Headers
import Data.Interval

-- | Splits an integer into list of integers such that its sum equals to the argument,
--   and each element of the list is of the form @(1 << x)@ for some @x@.
--   @splitBits 5@ produces @[ 1, 4 ]@
splitBits :: (Num w, FiniteBits w) => w -> [w]
splitBits :: forall w. (Num w, FiniteBits w) => w -> [w]
splitBits w
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Bits a => a -> Int -> a
shiftL w
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
L.filter (forall a. Bits a => a -> Int -> Bool
testBit w
w) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
subtract Int
1) [ Int
1 .. (forall b. FiniteBits b => b -> Int
finiteBitSize w
w) ]

formatPairs :: [(String, Doc a)] -> Doc a
formatPairs :: forall a. [([Char], Doc a)] -> Doc a
formatPairs [([Char], Doc a)]
ls = forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char], Doc a) -> Doc a
f [([Char], Doc a)]
ls
    where
        f :: ([Char], Doc a) -> Doc a
f ([Char]
n, Doc a
v) = forall ann. Int -> Doc ann -> Doc ann
fill Int
w (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
n forall a. Semigroup a => a -> a -> a
<> Doc a
":") forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
v
        w :: Int
w = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], Doc a)]
ls)

formatList :: [Doc ()] -> Doc ()
formatList :: [Doc ()] -> Doc ()
formatList = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ann. Doc ann -> Doc ann
f
    where
        f :: Doc ann -> Doc ann
f Doc ann
x = forall a ann. Pretty a => a -> Doc ann
pretty Char
'-' forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
x

padLeadingZeros :: Int -> String -> String
padLeadingZeros :: Int -> [Char] -> [Char]
padLeadingZeros Int
n [Char]
s | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Ord a => a -> a -> Bool
> Int
n = forall a. HasCallStack => [Char] -> a
error [Char]
"padLeadingZeros args"
                    | Bool
otherwise = [Char]
"0x" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
s

-- printWord8 :: Word8 -> Doc ()
-- printWord8 n = pretty $ padLeadingZeros 2 $ showHex n ""

printWord16 :: Word16 -> Doc ()
printWord16 :: Word16 -> Doc ()
printWord16 Word16
n = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padLeadingZeros Int
4 forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word16
n [Char]
""

printWord32 :: Word32 -> Doc ()
printWord32 :: Word32 -> Doc ()
printWord32 Word32
n = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padLeadingZeros Int
8 forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word32
n [Char]
""

printWord64 :: Word64 -> Doc ()
printWord64 :: Word64 -> Doc ()
printWord64 Word64
n = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padLeadingZeros Int
16 forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word64
n [Char]
""

printWordXXS :: SingElfClass a -> WordXX a -> Doc ()
printWordXXS :: forall (a :: ElfClass). SingElfClass a -> WordXX a -> Doc ()
printWordXXS SingElfClass a
SELFCLASS32 = Word32 -> Doc ()
printWord32
printWordXXS SingElfClass a
SELFCLASS64 = Word64 -> Doc ()
printWord64

printWordXX :: SingElfClassI a => WordXX a -> Doc ()
printWordXX :: forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX = forall (c :: ElfClass) r.
SingElfClassI c =>
(SingElfClass c -> r) -> r
withSingElfClass forall (a :: ElfClass). SingElfClass a -> WordXX a -> Doc ()
printWordXXS

-- | Print ELF header.  It's used in golden tests
printHeader :: forall a . SingElfClassI a => HeaderXX a -> Doc ()
printHeader :: forall (a :: ElfClass). SingElfClassI a => HeaderXX a -> Doc ()
printHeader HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
..} =
    forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"Class",      forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a )
        , ([Char]
"Data",       forall a ann. Show a => a -> Doc ann
viaShow ElfData
hData           ) -- ElfData
        , ([Char]
"OSABI",      forall a ann. Show a => a -> Doc ann
viaShow ElfOSABI
hOSABI          ) -- ElfOSABI
        , ([Char]
"ABIVersion", forall a ann. Show a => a -> Doc ann
viaShow Word8
hABIVersion     ) -- Word8
        , ([Char]
"Type",       forall a ann. Show a => a -> Doc ann
viaShow ElfType
hType           ) -- ElfType
        , ([Char]
"Machine",    forall a ann. Show a => a -> Doc ann
viaShow ElfMachine
hMachine        ) -- ElfMachine
        , ([Char]
"Entry",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
hEntry      ) -- WordXX c
        , ([Char]
"PhOff",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
hPhOff      ) -- WordXX c
        , ([Char]
"ShOff",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
hShOff      ) -- WordXX c
        , ([Char]
"Flags",      Word32 -> Doc ()
printWord32 Word32
hFlags      ) -- Word32
        , ([Char]
"PhEntSize",  Word16 -> Doc ()
printWord16 Word16
hPhEntSize  ) -- Word16
        , ([Char]
"PhNum",      forall a ann. Show a => a -> Doc ann
viaShow Word16
hPhNum          ) -- Word16
        , ([Char]
"ShEntSize",  Word16 -> Doc ()
printWord16  Word16
hShEntSize ) -- Word16
        , ([Char]
"ShNum",      forall a ann. Show a => a -> Doc ann
viaShow Word16
hShNum          ) -- Word16
        , ([Char]
"ShStrNdx",   forall a ann. Show a => a -> Doc ann
viaShow ElfSectionIndex
hShStrNdx       ) -- Word16
        ]

printSection :: SingElfClassI a => (Int, SectionXX a) -> Doc ()
printSection :: forall (a :: ElfClass).
SingElfClassI a =>
(Int, SectionXX a) -> Doc ()
printSection (Int
n, SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sOffset :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
..}) =
    forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"N",         forall a ann. Show a => a -> Doc ann
viaShow Int
n              )
        , ([Char]
"Name",      forall a ann. Show a => a -> Doc ann
viaShow Word32
sName          ) -- Word32
        , ([Char]
"Type",      forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
sType          ) -- ElfSectionType
        , ([Char]
"Flags",     forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sFlags     ) -- WordXX c
        , ([Char]
"Addr",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sAddr      ) -- WordXX c
        , ([Char]
"Offset",    forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sOffset    ) -- WordXX c
        , ([Char]
"Size",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sSize      ) -- WordXX c
        , ([Char]
"Link",      forall a ann. Show a => a -> Doc ann
viaShow Word32
sLink          ) -- Word32
        , ([Char]
"Info",      forall a ann. Show a => a -> Doc ann
viaShow Word32
sInfo          ) -- Word32
        , ([Char]
"AddrAlign", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sAddrAlign ) -- WordXX c
        , ([Char]
"EntSize",   forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sEntSize   ) -- WordXX c
        ]

printSegment :: SingElfClassI a => (Int, SegmentXX a) -> Doc ()
printSegment :: forall (a :: ElfClass).
SingElfClassI a =>
(Int, SegmentXX a) -> Doc ()
printSegment (Int
n, SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..}) =
    forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"N",        forall a ann. Show a => a -> Doc ann
viaShow Int
n             )
        , ([Char]
"Type",     forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
pType         ) -- ElfSegmentType
        , ([Char]
"Flags",    forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
pFlags ) -- ElfSegmentFlag
        , ([Char]
"Offset",   forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pOffset   ) -- WordXX c
        , ([Char]
"VirtAddr", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pVirtAddr ) -- WordXX c
        , ([Char]
"PhysAddr", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pPhysAddr ) -- WordXX c
        , ([Char]
"FileSize", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pFileSize ) -- WordXX c
        , ([Char]
"MemSize",  forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pMemSize  ) -- WordXX c
        , ([Char]
"Align",    forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pAlign    ) -- WordXX c
        ]

-- | Print parsed header, section table and segment table.
--   It's used in golden tests
printHeaders :: SingElfClassI a => HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> Doc ()
printHeaders :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> Doc ()
printHeaders HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps =
    let
        h :: Doc ()
h  = forall (a :: ElfClass). SingElfClassI a => HeaderXX a -> Doc ()
printHeader HeaderXX a
hdr
        s :: [Doc ()]
s  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ElfClass).
SingElfClassI a =>
(Int, SectionXX a) -> Doc ()
printSection (forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0 .. ] [SectionXX a]
ss)
        p :: [Doc ()]
p  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ElfClass).
SingElfClassI a =>
(Int, SegmentXX a) -> Doc ()
printSegment (forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0 .. ] [SegmentXX a]
ps)
    in
        forall a. [([Char], Doc a)] -> Doc a
formatPairs
            [ ([Char]
"Header",       Doc ()
h)
            , ([Char]
"Sections",     [Doc ()] -> Doc ()
formatList [Doc ()]
s)
            , ([Char]
"Segments",     [Doc ()] -> Doc ()
formatList [Doc ()]
p)
            ]

--------------------------------------------------------------------
--
--------------------------------------------------------------------

printRBuilder :: SingElfClassI a => [RBuilder a] -> Doc ()
printRBuilder :: forall (a :: ElfClass). SingElfClassI a => [RBuilder a] -> Doc ()
printRBuilder [RBuilder a]
rbs = forall ann. [Doc ann] -> Doc ann
vsep [Doc ()]
ldoc

    where

        mapL :: (t -> b) -> (a, t, c) -> (a, b, c)
mapL t -> b
f (a
ix, t
sx, c
dx) = (a
ix, t -> b
f t
sx, c
dx)
        getS :: (a, b, c) -> b
getS (a
_, b
sx, c
_) = b
sx

        longest :: [(a, t a, c)] -> Int
longest [] = Int
0
        longest [(a, t a, c)]
rbs' = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> b
getS) [(a, t a, c)]
rbs'

        padL :: Int -> [Char] -> [Char]
padL Int
n [Char]
s | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Ord a => a -> a -> Bool
> Int
n = forall a. HasCallStack => [Char] -> a
error [Char]
"incorrect number of pad symbols for `padL`"
                 | Bool
otherwise = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
s

        equalize :: Int -> f (a, [Char], c) -> f (a, [Char], c)
equalize Int
l = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {t} {b} {a} {c}. (t -> b) -> (a, t, c) -> (a, b, c)
mapL (Int -> [Char] -> [Char]
padL Int
l))

        printLine :: (a, a, [Doc ()]) -> Doc ()
printLine (a
pos, a
g, [Doc ()]
doc) = forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty a
g forall a. a -> [a] -> [a]
: Word32 -> Doc ()
printWord32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
pos) forall a. a -> [a] -> [a]
: [Doc ()]
doc
        ls :: [(WordXX a, [Char], [Doc ()])]
ls = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {c :: ElfClass}.
SingElfClassI c =>
RBuilder c -> [(WordXX c, [Char], [Doc ()])]
printRBuilder' [RBuilder a]
rbs
        len :: Int
len = forall {t :: * -> *} {a} {a} {c}.
Foldable t =>
[(a, t a, c)] -> Int
longest [(WordXX a, [Char], [Doc ()])]
ls
        ldoc :: [Doc ()]
ldoc = forall {a} {a}.
(Pretty a, Integral a) =>
(a, a, [Doc ()]) -> Doc ()
printLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *} {a} {c}.
Functor f =>
Int -> f (a, [Char], c) -> f (a, [Char], c)
equalize Int
len [(WordXX a, [Char], [Doc ()])]
ls

        printRBuilder' :: RBuilder c -> [(WordXX c, [Char], [Doc ()])]
printRBuilder' RBuilder c
rb = RBuilder c -> [(WordXX c, [Char], [Doc ()])]
f RBuilder c
rb
            where

                i :: Interval (WordXX c)
i@(I WordXX c
o WordXX c
s) = forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder c
rb

                f :: RBuilder c -> [(WordXX c, [Char], [Doc ()])]
f RBuilderHeader{} =
                    [ (WordXX c
o,         [Char]
"┎", [Doc ()
"H"])
                    , (WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
"┖", [])
                    ]
                f RBuilderSectionTable{ rbstHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbstHeader = HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX c
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} } =
                    if Word16
hShNum forall a. Eq a => a -> a -> Bool
== Word16
0
                        then []
                        else
                            [ (WordXX c
o,         [Char]
"┎", [Doc ()
"ST", forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Show a => a -> Doc ann
viaShow Word16
hShNum])
                            , (WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
"┖", [])
                            ]
                f RBuilderSegmentTable{ rbptHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbptHeader = HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX c
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} } =
                    if Word16
hPhNum forall a. Eq a => a -> a -> Bool
== Word16
0
                        then []
                        else
                            [ (WordXX c
o,         [Char]
"┎", [Doc ()
"PT", forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Show a => a -> Doc ann
viaShow Word16
hPhNum])
                            , (WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
"┖", [])
                            ]
                f RBuilderSection{ rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = SectionXX{Word32
ElfSectionType
WordXX c
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..}, [Char]
ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> [Char]
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: [Char]
rbsN :: ElfSectionIndex
..} =
                    let
                        doc :: [Doc ()]
doc = [ Doc ()
"S" forall a. Semigroup a => a -> a -> a
<> forall a ann. Show a => a -> Doc ann
viaShow (forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
rbsN :: Word)
                              , forall ann. Doc ann -> Doc ann
dquotes forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty [Char]
rbsName
                              , forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
sType
                              , forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall w. (Num w, FiniteBits w) => w -> [w]
splitBits forall a b. (a -> b) -> a -> b
$ Word64 -> ElfSectionFlag
ElfSectionFlag forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX c
sFlags
                              ]
                    in
                        if forall a. (Ord a, Num a) => Interval a -> Bool
empty Interval (WordXX c)
i
                            then
                                [(WordXX c
o, [Char]
"-", [Doc ()]
doc)]
                            else
                                [(WordXX c
o,         [Char]
"╓", [Doc ()]
doc)
                                ,(WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
"╙", [])
                                ]
                f RBuilderSegment{ rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..}, [RBuilder c]
Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: [RBuilder c]
rbpN :: Word16
..} =
                    let
                        doc :: [Doc ()]
doc = [ Doc ()
"P"
                              , forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
pType
                              , forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
pFlags
                              ]
                    in
                        if forall a. (Ord a, Num a) => Interval a -> Bool
empty Interval (WordXX c)
i Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [RBuilder c]
rbpData
                            then
                                [(WordXX c
o, [Char]
"-", [Doc ()]
doc)]
                            else
                                let
                                    xs :: [(WordXX c, [Char], [Doc ()])]
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RBuilder c -> [(WordXX c, [Char], [Doc ()])]
printRBuilder' [RBuilder c]
rbpData
                                    l :: Int
l = forall {t :: * -> *} {a} {a} {c}.
Foldable t =>
[(a, t a, c)] -> Int
longest [(WordXX c, [Char], [Doc ()])]
xs
                                    appendSectionBar :: [(a1, String, c1)] -> [(a1, String, c1)]
                                    appendSectionBar :: forall a1 c1. [(a1, [Char], c1)] -> [(a1, [Char], c1)]
appendSectionBar = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {t} {b} {a} {c}. (t -> b) -> (a, t, c) -> (a, b, c)
mapL (Char
'│' forall a. a -> [a] -> [a]
: ))
                                    xsf :: [(WordXX c, [Char], [Doc ()])]
xsf = forall a1 c1. [(a1, [Char], c1)] -> [(a1, [Char], c1)]
appendSectionBar forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a} {c}.
Functor f =>
Int -> f (a, [Char], c) -> f (a, [Char], c)
equalize Int
l [(WordXX c, [Char], [Doc ()])]
xs
                                    b :: [Char]
b = Char
'┌' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
l Char
'─'
                                    e :: [Char]
e = Char
'└' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
l Char
'─'
                                in
                                    [(WordXX c
o,                                [Char]
b, [Doc ()]
doc)] forall a. [a] -> [a] -> [a]
++
                                    [(WordXX c, [Char], [Doc ()])]
xsf                                          forall a. [a] -> [a] -> [a]
++
                                    [(if forall a. (Ord a, Num a) => Interval a -> Bool
empty Interval (WordXX c)
i then WordXX c
o else WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
e, [] )]
                f RBuilderRawData{} =
                    let
                        doc :: [Doc ()]
                        doc :: [Doc ()]
doc = [ Doc ()
"R" ]
                    in
                        [(WordXX c
o,         [Char]
"╓", [Doc ()]
doc)
                        ,(WordXX c
o forall a. Num a => a -> a -> a
+ WordXX c
s forall a. Num a => a -> a -> a
- WordXX c
1, [Char]
"╙", [])
                        ]
                f RBuilderRawAlign{} = []

-- | Print ELF layout.  First parse ELF with `parseHeaders`, then use this function to
--   format the layout.
printLayout :: MonadCatch m => Headers -> BSL.ByteString -> m (Doc ())
printLayout :: forall (m :: * -> *).
MonadCatch m =>
Headers -> ByteString -> m (Doc ())
printLayout (Headers SingElfClass a
classS HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps) ByteString
bs = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS do
    [RBuilder a]
rbs <- forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
parseRBuilder HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass). SingElfClassI a => [RBuilder a] -> Doc ()
printRBuilder [RBuilder a]
rbs

--------------------------------------------------------------------
--
--------------------------------------------------------------------

formatPairsBlock :: Doc a -> [(String, Doc a)] -> Doc a
formatPairsBlock :: forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc a
name [([Char], Doc a)]
pairs = forall ann. [Doc ann] -> Doc ann
vsep [ Doc a
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"{", forall ann. Int -> Doc ann -> Doc ann
indent Int
4 forall a b. (a -> b) -> a -> b
$ forall a. [([Char], Doc a)] -> Doc a
formatPairs [([Char], Doc a)]
pairs, Doc a
"}" ]

printElfSymbolTableEntry :: SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry :: forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry ElfSymbolXX{[Char]
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steSize :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steShNdx :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steType :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steBind :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steName :: forall (c :: ElfClass). ElfSymbolXX c -> [Char]
steSize :: WordXX a
steValue :: WordXX a
steShNdx :: ElfSectionIndex
steType :: ElfSymbolType
steBind :: ElfSymbolBinding
steName :: [Char]
..} =
    forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock (Doc ()
"symbol" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
steName))
        [ ([Char]
"Bind",  forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolBinding
steBind      ) -- ElfSymbolBinding
        , ([Char]
"Type",  forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolType
steType      ) -- ElfSymbolType
        , ([Char]
"ShNdx", forall a ann. Show a => a -> Doc ann
viaShow ElfSectionIndex
steShNdx     ) -- ElfSectionIndex
        , ([Char]
"Value", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steValue ) -- WordXX c
        , ([Char]
"Size",  forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steSize  ) -- WordXX c
        ]

printElfSymbolTable :: SingElfClassI a => Bool -> [ElfSymbolXX a] -> Doc ()
printElfSymbolTable :: forall (a :: ElfClass).
SingElfClassI a =>
Bool -> [ElfSymbolXX a] -> Doc ()
printElfSymbolTable Bool
full [ElfSymbolXX a]
l = if Bool
full then Doc ()
printElfSymbolTableFull else Doc ()
printElfSymbolTable'
    where
        printElfSymbolTableFull :: Doc ()
printElfSymbolTableFull = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry [ElfSymbolXX a]
l
        printElfSymbolTable' :: Doc ()
printElfSymbolTable' = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$
            case [ElfSymbolXX a]
l of
                (ElfSymbolXX a
e1 : ElfSymbolXX a
e2 : ElfSymbolXX a
_ : ElfSymbolXX a
_ : [ElfSymbolXX a]
_) ->
                    [ forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry ElfSymbolXX a
e1
                    , forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry ElfSymbolXX a
e2
                    , Doc ()
"..."
                    , forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [ElfSymbolXX a]
l
                    , Doc ()
"total:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [ElfSymbolXX a]
l)
                    ]
                [ElfSymbolXX a]
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry [ElfSymbolXX a]
l

splitBy :: Int64 -> BSL.ByteString -> [BSL.ByteString]
splitBy :: Int64 -> ByteString -> [ByteString]
splitBy Int64
n = forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr ByteString -> Maybe (ByteString, ByteString)
f
    where
        f :: ByteString -> Maybe (ByteString, ByteString)
f ByteString
s | ByteString -> Bool
BSL.null ByteString
s = forall a. Maybe a
Nothing
            | Bool
otherwise  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt Int64
n ByteString
s

formatChar :: Char -> Doc ()
formatChar :: Char -> Doc ()
formatChar Char
c = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ if Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
c) then Char
c else Char
'.'

formatHex :: Word8 -> Doc ()
formatHex :: Word8 -> Doc ()
formatHex Word8
w = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ case forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Word8
w [Char]
"" of
    [ Char
d ] -> [ Char
'0', Char
d ]
    [Char]
ww -> [Char]
ww

formatBytestringChar :: BSL.ByteString -> Doc ()
formatBytestringChar :: ByteString -> Doc ()
formatBytestringChar = forall ann. [Doc ann] -> Doc ann
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
L.map Char -> Doc ()
formatChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSL8.unpack

formatBytestringHex :: BSL.ByteString -> Doc ()
formatBytestringHex :: ByteString -> Doc ()
formatBytestringHex = forall ann. [Doc ann] -> Doc ann
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
L.map Word8 -> Doc ()
formatHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack

formatBytestringLine :: BSL.ByteString -> Doc ()
formatBytestringLine :: ByteString -> Doc ()
formatBytestringLine ByteString
s = forall ann. Int -> Doc ann -> Doc ann
fill (Int
16 forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
15) (ByteString -> Doc ()
formatBytestringHex ByteString
s)
                      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Char
'#'
                      forall ann. Doc ann -> Doc ann -> Doc ann
<+> ByteString -> Doc ()
formatBytestringChar ByteString
s

printData :: Bool -> BSL.ByteString -> Doc ()
printData :: Bool -> ByteString -> Doc ()
printData Bool
full ByteString
bs = if Bool
full then Doc ()
printDataFull else Doc ()
printData'
    where
        printDataFull :: Doc ()
printDataFull = forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
L.map ByteString -> Doc ()
formatBytestringLine forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> [ByteString]
splitBy Int64
16 ByteString
bs
        printData' :: Doc ()
printData' = forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$
            case Int64 -> ByteString -> [ByteString]
splitBy Int64
16 ByteString
bs of
                (ByteString
c1 : ByteString
c2 : ByteString
_ : ByteString
_ : [ByteString]
_) ->
                    [ ByteString -> Doc ()
formatBytestringLine ByteString
c1
                    , ByteString -> Doc ()
formatBytestringLine ByteString
c2
                    , Doc ()
"..."
                    , ByteString -> Doc ()
formatBytestringLine ByteString
cl
                    , Doc ()
"total:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (ByteString -> Int64
BSL.length ByteString
bs)
                    ]
                [ByteString]
chunks -> forall a b. (a -> b) -> [a] -> [b]
L.map ByteString -> Doc ()
formatBytestringLine [ByteString]
chunks
        cl :: ByteString
cl = Int64 -> ByteString -> ByteString
BSL.drop (ByteString -> Int64
BSL.length ByteString
bs forall a. Num a => a -> a -> a
- Int64
16) ByteString
bs

printElfSymbolTableEntryLine :: SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntryLine :: forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntryLine ElfSymbolXX{[Char]
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steSize :: WordXX a
steValue :: WordXX a
steShNdx :: ElfSectionIndex
steType :: ElfSymbolType
steBind :: ElfSymbolBinding
steName :: [Char]
steSize :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steShNdx :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steType :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steBind :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steName :: forall (c :: ElfClass). ElfSymbolXX c -> [Char]
..} =  forall ann. Doc ann -> Doc ann
parens (forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
steName)
                                                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"bind:"   forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolBinding
steBind
                                                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"type:"   forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolType
steType
                                                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"sindex:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow ElfSectionIndex
steShNdx
                                                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"value:"  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steValue
                                                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"size:"   forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steSize)

printRelocationTableA_AARCH64 :: MonadThrow m => Bool -> Word32 -> ElfListXX 'ELFCLASS64 -> BSL.ByteString -> m (Doc ())
printRelocationTableA_AARCH64 :: forall (m :: * -> *).
MonadThrow m =>
Bool -> Word32 -> ElfListXX 'ELFCLASS64 -> ByteString -> m (Doc ())
printRelocationTableA_AARCH64 Bool
full Word32
sLink ElfListXX 'ELFCLASS64
elfs ByteString
bs = do
    ElfXX 'Section 'ELFCLASS64
symTableSection <- forall (a :: ElfClass) (m :: * -> *) b.
(SingElfClassI a, MonadThrow m, Integral b, Show b) =>
ElfListXX a -> b -> m (ElfXX 'Section a)
elfFindSection ElfListXX 'ELFCLASS64
elfs Word32
sLink
    [ElfSymbolXX 'ELFCLASS64]
symTable <- forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
parseSymbolTable ElfData
ELFDATA2LSB ElfXX 'Section 'ELFCLASS64
symTableSection ElfListXX 'ELFCLASS64
elfs
    let
        getSymbolTableEntry' :: [a] -> t -> m a
getSymbolTableEntry' []     t
_  = $Int
[Char]
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"wrong symbol table index"
        getSymbolTableEntry' (a
x:[a]
_)  t
0  = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        getSymbolTableEntry' (a
_:[a]
xs) t
n  = [a] -> t -> m a
getSymbolTableEntry' [a]
xs (t
n forall a. Num a => a -> a -> a
- t
1)

        getSymbolTableEntry :: MonadThrow m => Word32 -> m (ElfSymbolXX 'ELFCLASS64)
        getSymbolTableEntry :: forall (m :: * -> *).
MonadThrow m =>
Word32 -> m (ElfSymbolXX 'ELFCLASS64)
getSymbolTableEntry = forall {m :: * -> *} {t} {a}.
(MonadThrow m, Eq t, Num t) =>
[a] -> t -> m a
getSymbolTableEntry' [ElfSymbolXX 'ELFCLASS64]
symTable

        f :: MonadThrow m => RelaXX 'ELFCLASS64 -> m (Doc ())
        f :: forall (m :: * -> *).
MonadThrow m =>
RelaXX 'ELFCLASS64 -> m (Doc ())
f RelaXX{Word32
WordXX 'ELFCLASS64
relaAddend :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaType :: forall (c :: ElfClass). RelaXX c -> Word32
relaSym :: forall (c :: ElfClass). RelaXX c -> Word32
relaOffset :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaAddend :: WordXX 'ELFCLASS64
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX 'ELFCLASS64
..} = do
            ElfSymbolXX 'ELFCLASS64
symbolTableEntry <- forall (m :: * -> *).
MonadThrow m =>
Word32 -> m (ElfSymbolXX 'ELFCLASS64)
getSymbolTableEntry Word32
relaSym
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$  Word64 -> Doc ()
printWord64 WordXX 'ELFCLASS64
relaOffset
                  forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word64 -> Doc ()
printWord64 WordXX 'ELFCLASS64
relaAddend
                  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (Word32 -> ElfRelocationType_AARCH64
ElfRelocationType_AARCH64 Word32
relaType)
                  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Word32
relaSym
                  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntryLine ElfSymbolXX 'ELFCLASS64
symbolTableEntry

        split :: [Doc ()] -> [Doc ()]
split [Doc ()]
xs = if Bool
full then [Doc ()]
xs else
            case [Doc ()]
xs of
                (Doc ()
x1 : Doc ()
x2 : Doc ()
_ : Doc ()
_ : [Doc ()]
_) ->
                    [ Doc ()
x1, Doc ()
x2, Doc ()
"...", forall a. [a] -> a
last [Doc ()]
xs, Doc ()
"total:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc ()]
xs) ]
                [Doc ()]
_ -> [Doc ()]
xs

    [RelaXX 'ELFCLASS64]
relas <- forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
ELFDATA2LSB ByteString
bs
    forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> [Doc ()]
split forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
MonadThrow m =>
RelaXX 'ELFCLASS64 -> m (Doc ())
f [RelaXX 'ELFCLASS64]
relas

-- | Same as @`printElf_` False@
printElf :: MonadThrow m => Elf -> m (Doc ())
printElf :: forall (m :: * -> *). MonadThrow m => Elf -> m (Doc ())
printElf = forall (m :: * -> *). MonadThrow m => Bool -> Elf -> m (Doc ())
printElf_ Bool
False

-- | Print ELF.  If first argument is False, don't dump all the data, print just the first two and the last lines.
printElf_ :: MonadThrow m => Bool -> Elf -> m (Doc ())
printElf_ :: forall (m :: * -> *). MonadThrow m => Bool -> Elf -> m (Doc ())
printElf_ Bool
full (Elf SingElfClass a
classS ElfListXX a
elfs) = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass) (m :: * -> *).
(MonadThrow m, SingElfClassI a) =>
Bool -> ElfListXX a -> m (Doc ())
printElf_' Bool
full ElfListXX a
elfs

printElf_' :: forall a m . (MonadThrow m, SingElfClassI a) => Bool -> ElfListXX a -> m (Doc ())
printElf_' :: forall (a :: ElfClass) (m :: * -> *).
(MonadThrow m, SingElfClassI a) =>
Bool -> ElfListXX a -> m (Doc ())
printElf_' Bool
full ElfListXX a
elfs = do

    -- FIXME: lazy matching here is a workaround for some GHC bug, see
    -- https://stackoverflow.com/questions/72803815/phantom-type-makes-pattern-matching-irrefutable-but-that-seemingly-does-not-wor
    -- https://gitlab.haskell.org/ghc/ghc/-/issues/15681#note_165436
    ~(ElfHeader { Word8
Word32
ElfOSABI
ElfType
ElfMachine
WordXX a
ElfData
ehFlags :: forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehEntry :: forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehMachine :: forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehType :: forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehABIVersion :: forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehOSABI :: forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehData :: forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehFlags :: Word32
ehEntry :: WordXX a
ehMachine :: ElfMachine
ehType :: ElfType
ehABIVersion :: Word8
ehOSABI :: ElfOSABI
ehData :: ElfData
.. }) <- forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs

    let

        printElf' :: ElfListXX a -> m (Doc ())
        printElf' :: ElfListXX a -> m (Doc ())
printElf' ElfListXX a
elfs' = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList forall (t' :: ElfNodeType). ElfXX t' a -> m (Doc ())
printElf'' ElfListXX a
elfs'

        printElf'' :: ElfXX t' a -> m (Doc ())
        printElf'' :: forall (t' :: ElfNodeType). ElfXX t' a -> m (Doc ())
printElf'' ElfHeader {} =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"header"
                [ ([Char]
"Class",      forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a)
                , ([Char]
"Data",       forall a ann. Show a => a -> Doc ann
viaShow ElfData
ehData       ) -- ElfData
                , ([Char]
"OSABI",      forall a ann. Show a => a -> Doc ann
viaShow ElfOSABI
ehOSABI      ) -- ElfOSABI
                , ([Char]
"ABIVersion", forall a ann. Show a => a -> Doc ann
viaShow Word8
ehABIVersion ) -- Word8
                , ([Char]
"Type",       forall a ann. Show a => a -> Doc ann
viaShow ElfType
ehType       ) -- ElfType
                , ([Char]
"Machine",    forall a ann. Show a => a -> Doc ann
viaShow ElfMachine
ehMachine    ) -- ElfMachine
                , ([Char]
"Entry",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
ehEntry  ) -- WordXX c
                , ([Char]
"Flags",      Word32 -> Doc ()
printWord32 Word32
ehFlags  ) -- Word32
                ]
        printElf'' s :: ElfXX t' a
s@ElfSection{ [Char]
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> [Char]
esData :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: [Char]
..} =
            let
                printSection' :: Doc () -> Doc () -> Doc ()
printSection' Doc ()
sectionTitle Doc ()
dataDoc = forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock (Doc ()
sectionTitle forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
esN :: Word) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
esName))
                    [ ([Char]
"Type",       forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
esType          )
                    , ([Char]
"Flags",      forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSectionFlag
esFlags )
                    , ([Char]
"Addr",       forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
esAddr      )
                    , ([Char]
"AddrAlign",  forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
esAddrAlign )
                    , ([Char]
"EntSize",    forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
esEntSize   )
                    , ([Char]
"Info",       Word32 -> Doc ()
printWord32 Word32
esInfo      )
                    , ([Char]
"Link",       Word32 -> Doc ()
printWord32 Word32
esLink      )
                    , ([Char]
"Data",       Doc ()
dataDoc )
                    ]
            in
                case ElfSectionData a
esData of
                    ElfSectionDataNoBits { WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX a
.. } ->
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"section" (Doc ()
"NoBits:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow WordXX a
esdSize)
                    ElfSectionData a
ElfSectionDataStringTable ->
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc ()
"string table section" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow (forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
esN :: Word) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
esName)
                    ElfSectionData ByteString
bs ->
                        if ElfSectionType -> Bool
sectionIsSymbolTable ElfSectionType
esType
                            then do
                                [ElfSymbolXX a]
stes <- forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
parseSymbolTable ElfData
ehData ElfXX t' a
s ElfListXX a
elfs
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"symbol table section" forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ElfSymbolXX a]
stes then Doc ()
"" else forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (forall (a :: ElfClass).
SingElfClassI a =>
Bool -> [ElfSymbolXX a] -> Doc ()
printElfSymbolTable Bool
full [ElfSymbolXX a]
stes)
                            else if ElfMachine
ehMachine forall a. Eq a => a -> a -> Bool
== ElfMachine
EM_AARCH64
                                    Bool -> Bool -> Bool
&& ElfData
ehData forall a. Eq a => a -> a -> Bool
== ElfData
ELFDATA2LSB
                                    Bool -> Bool -> Bool
&& ElfSectionType
esType forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_RELA
                                 Bool -> Bool -> Bool
&& WordXX a
esEntSize forall a. Eq a => a -> a -> Bool
== forall (a :: ElfClass). SingElfClassI a => WordXX a
relocationTableAEntrySize then
                                    case forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a of
                                        SingElfClass a
SELFCLASS64 -> Doc () -> Doc () -> Doc ()
printSection' Doc ()
"section" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadThrow m =>
Bool -> Word32 -> ElfListXX 'ELFCLASS64 -> ByteString -> m (Doc ())
printRelocationTableA_AARCH64 Bool
full Word32
esLink ElfListXX a
elfs ByteString
bs
                                        SingElfClass a
SELFCLASS32 -> $Int
[Char]
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"invalid ELF: EM_AARCH64 and ELFCLASS32"
                            else
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"section" forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> Doc ()
printData Bool
full ByteString
bs
        printElf'' ElfSegment{ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epData :: ElfListXX a
epAlign :: WordXX a
epAddMemSize :: WordXX a
epPhysAddr :: WordXX a
epVirtAddr :: WordXX a
epFlags :: ElfSegmentFlag
epType :: ElfSegmentType
..} = do
            Doc ()
dataDoc <- case ElfListXX a
epData of
                ElfListXX a
ElfListNull -> forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
""
                ElfListXX a
_ -> do
                    Doc ()
dataDoc' <- ElfListXX a -> m (Doc ())
printElf' ElfListXX a
epData
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
4 Doc ()
dataDoc'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"segment"
                [ ([Char]
"Type",       forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
epType         )
                , ([Char]
"Flags",      forall a ann. Show a => a -> Doc ann
viaShow forall a b. (a -> b) -> a -> b
$ forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
epFlags )
                , ([Char]
"VirtAddr",   forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epVirtAddr )
                , ([Char]
"PhysAddr",   forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epPhysAddr )
                , ([Char]
"AddMemSize", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epAddMemSize )
                , ([Char]
"Align",      forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epAlign    )
                , ([Char]
"Data",       Doc ()
dataDoc                )
                ]
        printElf'' ElfXX t' a
ElfSectionTable = forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
"section table"
        printElf'' ElfXX t' a
ElfSegmentTable = forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
"segment table"
        printElf'' ElfRawData{ByteString
edData :: forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: ByteString
..} =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"raw data"
                [ ([Char]
"Data",       Bool -> ByteString -> Doc ()
printData Bool
full ByteString
edData)
                ]
        printElf'' ElfRawAlign{WordXX a
eaAlign :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign :: WordXX a
eaOffset :: WordXX a
..} =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"raw align"
                [ ([Char]
"Offset", forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
eaOffset )
                , ([Char]
"Align",  forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
eaAlign  )
                ]

    ElfListXX a -> m (Doc ())
printElf' ElfListXX a
elfs

--------------------------------------------------------------------
--
--------------------------------------------------------------------

-- | Print string table.  It's used in golden tests
printStringTable :: MonadThrow m => BSL.ByteString -> m (Doc ())
printStringTable :: forall (m :: * -> *). MonadThrow m => ByteString -> m (Doc ())
printStringTable ByteString
bs =
    case ByteString -> Maybe (ByteString, Word8)
BSL.unsnoc ByteString
bs of
        Maybe (ByteString, Word8)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
""
        Just (ByteString
bs', Word8
e) -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
e forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ $Int
[Char]
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"string table should end with 0"
            forall (m :: * -> *) a. Monad m => a -> m a
return if ByteString -> Int64
BSL.length ByteString
bs' forall a. Eq a => a -> a -> Bool
== Int64
0
                then forall ann. Doc ann -> Doc ann
angles Doc ()
""
                else forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
angles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
L.sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> [Char]
BSL8.unpack forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> [ByteString]
BSL.splitWith (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs'

--------------------------------------------------------------------
--
--------------------------------------------------------------------

-- | Read the file strictly but return lazy bytestring
readFileLazy :: FilePath -> IO BSL.ByteString
readFileLazy :: [Char] -> IO ByteString
readFileLazy [Char]
path = ByteString -> ByteString
BSL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
BS.readFile [Char]
path

-- | Read ELF from one file, `printElf` it into another.
writeElfDump :: FilePath -> FilePath -> IO ()
writeElfDump :: [Char] -> [Char] -> IO ()
writeElfDump [Char]
i [Char]
o = do
    ByteString
bs <- [Char] -> IO ByteString
readFileLazy [Char]
i
    Elf
e <- forall (m :: * -> *). MonadCatch m => ByteString -> m Elf
parseElf ByteString
bs
    Doc ()
doc <- forall (m :: * -> *). MonadThrow m => Elf -> m (Doc ())
printElf Elf
e
    forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
o IOMode
WriteMode (\ Handle
h -> forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
h (Doc ()
doc forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line))

-- | Read ELF from one file, `printLayout` it into another.
writeElfLayout :: FilePath -> FilePath -> IO ()
writeElfLayout :: [Char] -> [Char] -> IO ()
writeElfLayout [Char]
i [Char]
o = do
    ByteString
bs <- [Char] -> IO ByteString
readFileLazy [Char]
i
    Headers
hdrs <- forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs
    Doc ()
doc <- forall (m :: * -> *).
MonadCatch m =>
Headers -> ByteString -> m (Doc ())
printLayout Headers
hdrs ByteString
bs
    forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
o IOMode
WriteMode (\ Handle
h -> forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
h (Doc ()
doc forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line))