-- |
-- 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 = (Int -> w) -> [Int] -> [w]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> Int -> w
forall a. Bits a => a -> Int -> a
shiftL w
1) ([Int] -> [w]) -> [Int] -> [w]
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit w
w) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) [ Int
1 .. (w -> Int
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 = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (([Char], Doc a) -> Doc a) -> [([Char], Doc a)] -> [Doc a]
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) = Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
fill Int
w ([Char] -> Doc a
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
n Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
":") Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
v
        w :: Int
w = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((([Char], Doc a) -> Int) -> [([Char], Doc a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int)
-> (([Char], Doc a) -> [Char]) -> ([Char], Doc a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Doc a) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Doc a)]
ls)

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

padLeadingZeros :: Int -> String -> String
padLeadingZeros :: Int -> [Char] -> [Char]
padLeadingZeros Int
n [Char]
s | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"padLeadingZeros args"
                    | Bool
otherwise = [Char]
"0x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' [Char] -> [Char] -> [Char]
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 = [Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ()) -> [Char] -> Doc ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padLeadingZeros Int
4 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Word16 -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex Word16
n [Char]
""

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

printWord64 :: Word64 -> Doc ()
printWord64 :: Word64 -> Doc ()
printWord64 Word64
n = [Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ()) -> [Char] -> Doc ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
padLeadingZeros Int
16 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Char] -> [Char]
forall a. Integral 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 ()
WordXX a -> Doc ()
printWord32
printWordXXS SingElfClass a
SELFCLASS64 = Word64 -> Doc ()
WordXX a -> Doc ()
printWord64

printWordXX :: SingElfClassI a => WordXX a -> Doc ()
printWordXX :: forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX = (SingElfClass a -> WordXX a -> Doc ()) -> WordXX a -> Doc ()
forall (c :: ElfClass) r.
SingElfClassI c =>
(SingElfClass c -> r) -> r
withSingElfClass SingElfClass a -> WordXX a -> Doc ()
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
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
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
..} =
    [([Char], Doc ())] -> Doc ()
forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"Class",      ElfClass -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ElfClass -> Doc ()) -> ElfClass -> Doc ()
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a )
        , ([Char]
"Data",       ElfData -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfData
hData           ) -- ElfData
        , ([Char]
"OSABI",      ElfOSABI -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfOSABI
hOSABI          ) -- ElfOSABI
        , ([Char]
"ABIVersion", Word8 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word8
hABIVersion     ) -- Word8
        , ([Char]
"Type",       ElfType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfType
hType           ) -- ElfType
        , ([Char]
"Machine",    ElfMachine -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfMachine
hMachine        ) -- ElfMachine
        , ([Char]
"Entry",      WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
hEntry      ) -- WordXX c
        , ([Char]
"PhOff",      WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
hPhOff      ) -- WordXX c
        , ([Char]
"ShOff",      WordXX a -> Doc ()
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",      Word16 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word16
hPhNum          ) -- Word16
        , ([Char]
"ShEntSize",  Word16 -> Doc ()
printWord16  Word16
hShEntSize ) -- Word16
        , ([Char]
"ShNum",      Word16 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word16
hShNum          ) -- Word16
        , ([Char]
"ShStrNdx",   ElfSectionIndex -> Doc ()
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
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: 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
..}) =
    [([Char], Doc ())] -> Doc ()
forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"N",         Int -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Int
n              )
        , ([Char]
"Name",      Word32 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word32
sName          ) -- Word32
        , ([Char]
"Type",      ElfSectionType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
sType          ) -- ElfSectionType
        , ([Char]
"Flags",     WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sFlags     ) -- WordXX c
        , ([Char]
"Addr",      WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sAddr      ) -- WordXX c
        , ([Char]
"Offset",    WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sOffset    ) -- WordXX c
        , ([Char]
"Size",      WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sSize      ) -- WordXX c
        , ([Char]
"Link",      Word32 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word32
sLink          ) -- Word32
        , ([Char]
"Info",      Word32 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word32
sInfo          ) -- Word32
        , ([Char]
"AddrAlign", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
sAddrAlign ) -- WordXX c
        , ([Char]
"EntSize",   WordXX a -> Doc ()
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
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: 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
..}) =
    [([Char], Doc ())] -> Doc ()
forall a. [([Char], Doc a)] -> Doc a
formatPairs
        [ ([Char]
"N",        Int -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Int
n             )
        , ([Char]
"Type",     ElfSegmentType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
pType         ) -- ElfSegmentType
        , ([Char]
"Flags",    [ElfSegmentFlag] -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSegmentFlag] -> Doc ()) -> [ElfSegmentFlag] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ElfSegmentFlag -> [ElfSegmentFlag]
forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
pFlags ) -- ElfSegmentFlag
        , ([Char]
"Offset",   WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pOffset   ) -- WordXX c
        , ([Char]
"VirtAddr", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pVirtAddr ) -- WordXX c
        , ([Char]
"PhysAddr", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pPhysAddr ) -- WordXX c
        , ([Char]
"FileSize", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pFileSize ) -- WordXX c
        , ([Char]
"MemSize",  WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
pMemSize  ) -- WordXX c
        , ([Char]
"Align",    WordXX a -> Doc ()
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  = HeaderXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => HeaderXX a -> Doc ()
printHeader HeaderXX a
hdr
        s :: [Doc ()]
s  = ((Int, SectionXX a) -> Doc ()) -> [(Int, SectionXX a)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, SectionXX a) -> Doc ()
forall (a :: ElfClass).
SingElfClassI a =>
(Int, SectionXX a) -> Doc ()
printSection ([Int] -> [SectionXX a] -> [(Int, SectionXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0 .. ] [SectionXX a]
ss)
        p :: [Doc ()]
p  = ((Int, SegmentXX a) -> Doc ()) -> [(Int, SegmentXX a)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, SegmentXX a) -> Doc ()
forall (a :: ElfClass).
SingElfClassI a =>
(Int, SegmentXX a) -> Doc ()
printSegment ([Int] -> [SegmentXX a] -> [(Int, SegmentXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Int
0 .. ] [SegmentXX a]
ps)
    in
        [([Char], Doc ())] -> Doc ()
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 = [Doc ()] -> Doc ()
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' = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((a, t a, c) -> Int) -> [(a, t a, c)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t a -> Int) -> ((a, t a, c) -> t a) -> (a, t a, c) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, t a, c) -> t a
forall {a} {b} {c}. (a, b, c) -> b
getS) [(a, t a, c)]
rbs'

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

        equalize :: Int -> f (a, [Char], c) -> f (a, [Char], c)
equalize Int
l = ((a, [Char], c) -> (a, [Char], c))
-> f (a, [Char], c) -> f (a, [Char], c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> [Char]) -> (a, [Char], c) -> (a, [Char], c)
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) = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ a -> Doc ()
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
g Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
: Word32 -> Doc ()
printWord32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
pos) Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
: [Doc ()]
doc
        ls :: [(WordXX a, [Char], [Doc ()])]
ls = (RBuilder a -> [(WordXX a, [Char], [Doc ()])])
-> [RBuilder a] -> [(WordXX a, [Char], [Doc ()])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RBuilder a -> [(WordXX a, [Char], [Doc ()])]
forall {c :: ElfClass}.
SingElfClassI c =>
RBuilder c -> [(WordXX c, [Char], [Doc ()])]
printRBuilder' [RBuilder a]
rbs
        len :: Int
len = [(WordXX a, [Char], [Doc ()])] -> Int
forall {t :: * -> *} {a} {a} {c}.
Foldable t =>
[(a, t a, c)] -> Int
longest [(WordXX a, [Char], [Doc ()])]
ls
        ldoc :: [Doc ()]
ldoc = (WordXX a, [Char], [Doc ()]) -> Doc ()
forall {a} {a}.
(Pretty a, Integral a) =>
(a, a, [Doc ()]) -> Doc ()
printLine ((WordXX a, [Char], [Doc ()]) -> Doc ())
-> [(WordXX a, [Char], [Doc ()])] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [(WordXX a, [Char], [Doc ()])] -> [(WordXX a, [Char], [Doc ()])]
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) = RBuilder c -> Interval (WordXX c)
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 WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 :: 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
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX c
hPhOff :: WordXX c
hShOff :: WordXX c
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} } =
                    if Word16
hShNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                        then []
                        else
                            [ (WordXX c
o,         [Char]
"┎", [Doc ()
"ST", Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ Word16 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word16
hShNum])
                            , (WordXX c
o WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 :: 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
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX c
hPhOff :: WordXX c
hShOff :: WordXX c
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} } =
                    if Word16
hPhNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
                        then []
                        else
                            [ (WordXX c
o,         [Char]
"┎", [Doc ()
"PT", Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ Word16 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word16
hPhNum])
                            , (WordXX c
o WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 :: 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
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX c
sAddr :: WordXX c
sOffset :: WordXX c
sSize :: WordXX c
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX c
sEntSize :: WordXX c
..}, [Char]
ElfSectionIndex
rbsN :: ElfSectionIndex
rbsName :: [Char]
rbsName :: forall (c :: ElfClass). RBuilder c -> [Char]
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
..} =
                    let
                        doc :: [Doc ()]
doc = [ Doc ()
"S" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Word -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ElfSectionIndex -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
rbsN :: Word)
                              , Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
rbsName
                              , ElfSectionType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
sType
                              , [ElfSectionFlag] -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSectionFlag] -> Doc ()) -> [ElfSectionFlag] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ElfSectionFlag -> [ElfSectionFlag]
forall w. (Num w, FiniteBits w) => w -> [w]
splitBits (ElfSectionFlag -> [ElfSectionFlag])
-> ElfSectionFlag -> [ElfSectionFlag]
forall a b. (a -> b) -> a -> b
$ Word64 -> ElfSectionFlag
ElfSectionFlag (Word64 -> ElfSectionFlag) -> Word64 -> ElfSectionFlag
forall a b. (a -> b) -> a -> b
$ WordXX c -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX c
sFlags
                              ]
                    in
                        if Interval (WordXX c) -> Bool
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 WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 :: 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
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX c
pVirtAddr :: WordXX c
pPhysAddr :: WordXX c
pFileSize :: WordXX c
pMemSize :: WordXX c
pAlign :: WordXX c
..}, [RBuilder c]
Word16
rbpN :: Word16
rbpData :: [RBuilder c]
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
..} =
                    let
                        doc :: [Doc ()]
doc = [ Doc ()
"P"
                              , ElfSegmentType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
pType
                              , [ElfSegmentFlag] -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSegmentFlag] -> Doc ()) -> [ElfSegmentFlag] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ElfSegmentFlag -> [ElfSegmentFlag]
forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
pFlags
                              ]
                    in
                        if Interval (WordXX c) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
empty Interval (WordXX c)
i Bool -> Bool -> Bool
&& [RBuilder c] -> Bool
forall a. [a] -> 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 = (RBuilder c -> [(WordXX c, [Char], [Doc ()])])
-> [RBuilder c] -> [(WordXX c, [Char], [Doc ()])]
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 = [(WordXX c, [Char], [Doc ()])] -> Int
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 = ((a1, [Char], c1) -> (a1, [Char], c1))
-> [(a1, [Char], c1)] -> [(a1, [Char], c1)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> [Char]) -> (a1, [Char], c1) -> (a1, [Char], c1)
forall {t} {b} {a} {c}. (t -> b) -> (a, t, c) -> (a, b, c)
mapL (Char
'│' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ))
                                    xsf :: [(WordXX c, [Char], [Doc ()])]
xsf = [(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])]
forall a1 c1. [(a1, [Char], c1)] -> [(a1, [Char], c1)]
appendSectionBar ([(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])])
-> [(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])]
forall a b. (a -> b) -> a -> b
$ Int
-> [(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])]
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
'┌' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
l Char
'─'
                                    e :: [Char]
e = Char
'└' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
l Char
'─'
                                in
                                    [(WordXX c
o,                                [Char]
b, [Doc ()]
doc)] [(WordXX c, [Char], [Doc ()])]
-> [(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])]
forall a. [a] -> [a] -> [a]
++
                                    [(WordXX c, [Char], [Doc ()])]
xsf                                          [(WordXX c, [Char], [Doc ()])]
-> [(WordXX c, [Char], [Doc ()])] -> [(WordXX c, [Char], [Doc ()])]
forall a. [a] -> [a] -> [a]
++
                                    [(if Interval (WordXX c) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
empty Interval (WordXX c)
i then WordXX c
o else WordXX c
o WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 WordXX c -> WordXX c -> WordXX c
forall a. Num a => a -> a -> a
+ WordXX c
s WordXX c -> WordXX c -> WordXX c
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 = SingElfClass a -> (SingElfClassI a => m (Doc ())) -> m (Doc ())
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS do
    [RBuilder a]
rbs <- HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
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
    Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> Doc ()
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 = [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep [ Doc a
name Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"{", Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [([Char], Doc a)] -> Doc a
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
steName :: [Char]
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: 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]
..} =
    Doc () -> [([Char], Doc ())] -> Doc ()
forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock (Doc ()
"symbol" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes ([Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
steName))
        [ ([Char]
"Bind",  ElfSymbolBinding -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolBinding
steBind      ) -- ElfSymbolBinding
        , ([Char]
"Type",  ElfSymbolType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolType
steType      ) -- ElfSymbolType
        , ([Char]
"ShNdx", ElfSectionIndex -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSectionIndex
steShNdx     ) -- ElfSectionIndex
        , ([Char]
"Value", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steValue ) -- WordXX c
        , ([Char]
"Size",  WordXX a -> Doc ()
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 = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (ElfSymbolXX a -> Doc ()) -> [ElfSymbolXX a] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElfSymbolXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry [ElfSymbolXX a]
l
        printElfSymbolTable' :: Doc ()
printElfSymbolTable' = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$
            case [ElfSymbolXX a]
l of
                (ElfSymbolXX a
e1 : ElfSymbolXX a
e2 : ElfSymbolXX a
_ : ElfSymbolXX a
_ : [ElfSymbolXX a]
_) ->
                    [ ElfSymbolXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry ElfSymbolXX a
e1
                    , ElfSymbolXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry ElfSymbolXX a
e2
                    , Doc ()
"..."
                    , ElfSymbolXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => ElfSymbolXX a -> Doc ()
printElfSymbolTableEntry (ElfSymbolXX a -> Doc ()) -> ElfSymbolXX a -> Doc ()
forall a b. (a -> b) -> a -> b
$ [ElfSymbolXX a] -> ElfSymbolXX a
forall a. HasCallStack => [a] -> a
last [ElfSymbolXX a]
l
                    , Doc ()
"total:" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSymbolXX a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [ElfSymbolXX a]
l)
                    ]
                [ElfSymbolXX a]
_ -> (ElfSymbolXX a -> Doc ()) -> [ElfSymbolXX a] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElfSymbolXX a -> Doc ()
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 = (ByteString -> Maybe (ByteString, ByteString))
-> ByteString -> [ByteString]
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 = Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
            | Bool
otherwise  = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
-> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
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 = Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char -> Doc ()) -> Char -> Doc ()
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 = [Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ()) -> [Char] -> Doc ()
forall a b. (a -> b) -> a -> b
$ case Word8 -> [Char] -> [Char]
forall a. Integral 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 = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hcat ([Doc ()] -> Doc ())
-> (ByteString -> [Doc ()]) -> ByteString -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc ()) -> [Char] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
L.map Char -> Doc ()
formatChar ([Char] -> [Doc ()])
-> (ByteString -> [Char]) -> ByteString -> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSL8.unpack

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

formatBytestringLine :: BSL.ByteString -> Doc ()
formatBytestringLine :: ByteString -> Doc ()
formatBytestringLine ByteString
s = Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
fill (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
15) (ByteString -> Doc ()
formatBytestringHex ByteString
s)
                      Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc ()
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'#'
                      Doc () -> Doc () -> Doc ()
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 = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc ()) -> [ByteString] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
L.map ByteString -> Doc ()
formatBytestringLine ([ByteString] -> [Doc ()]) -> [ByteString] -> [Doc ()]
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> [ByteString]
splitBy Int64
16 ByteString
bs
        printData' :: Doc ()
printData' = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
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:" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ByteString -> Int64
BSL.length ByteString
bs)
                    ]
                [ByteString]
chunks -> (ByteString -> Doc ()) -> [ByteString] -> [Doc ()]
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 Int64 -> Int64 -> Int64
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 :: 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]
steName :: [Char]
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
..} =  Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens (Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes ([Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
steName)
                                                    Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"bind:"   Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElfSymbolBinding -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolBinding
steBind
                                                    Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"type:"   Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElfSymbolType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSymbolType
steType
                                                    Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"sindex:" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElfSectionIndex -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSectionIndex
steShNdx
                                                    Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"value:"  Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
steValue
                                                    Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"size:"   Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WordXX a -> Doc ()
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 <- ElfListXX 'ELFCLASS64 -> Word32 -> m (ElfXX 'Section 'ELFCLASS64)
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 <- ElfData
-> ElfXX 'Section 'ELFCLASS64
-> ElfListXX 'ELFCLASS64
-> m [ElfSymbolXX 'ELFCLASS64]
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
Loc -> [Char] -> m a
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"wrong symbol table index"
        getSymbolTableEntry' (a
x:[a]
_)  t
0  = a -> m a
forall a. a -> m a
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 t -> t -> t
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 = [ElfSymbolXX 'ELFCLASS64] -> Word32 -> m (ElfSymbolXX 'ELFCLASS64)
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
relaOffset :: WordXX 'ELFCLASS64
relaSym :: Word32
relaType :: Word32
relaAddend :: 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
..} = do
            ElfSymbolXX 'ELFCLASS64
symbolTableEntry <- Word32 -> m (ElfSymbolXX 'ELFCLASS64)
forall (m :: * -> *).
MonadThrow m =>
Word32 -> m (ElfSymbolXX 'ELFCLASS64)
getSymbolTableEntry Word32
relaSym
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$  Word64 -> Doc ()
printWord64 Word64
WordXX 'ELFCLASS64
relaOffset
                  Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word64 -> Doc ()
printWord64 Word64
WordXX 'ELFCLASS64
relaAddend
                  Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElfRelocationType_AARCH64 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (Word32 -> ElfRelocationType_AARCH64
ElfRelocationType_AARCH64 Word32
relaType)
                  Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word32 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word32
relaSym
                  Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ElfSymbolXX 'ELFCLASS64 -> Doc ()
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 ()
"...", [Doc ()] -> Doc ()
forall a. HasCallStack => [a] -> a
last [Doc ()]
xs, Doc ()
"total:" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([Doc ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc ()]
xs) ]
                [Doc ()]
_ -> [Doc ()]
xs

    [RelaXX 'ELFCLASS64]
relas <- ElfData -> ByteString -> m [RelaXX 'ELFCLASS64]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
ELFDATA2LSB ByteString
bs
    Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ())
-> ([Doc ()] -> [Doc ()]) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> [Doc ()]
split ([Doc ()] -> Doc ()) -> m [Doc ()] -> m (Doc ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RelaXX 'ELFCLASS64 -> m (Doc ()))
-> [RelaXX 'ELFCLASS64] -> m [Doc ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RelaXX 'ELFCLASS64 -> m (Doc ())
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 = Bool -> Elf -> m (Doc ())
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) = SingElfClass a -> (SingElfClassI a => m (Doc ())) -> m (Doc ())
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS ((SingElfClassI a => m (Doc ())) -> m (Doc ()))
-> (SingElfClassI a => m (Doc ())) -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Bool -> ElfListXX a -> m (Doc ())
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
ehData :: ElfData
ehOSABI :: ElfOSABI
ehABIVersion :: Word8
ehType :: ElfType
ehMachine :: ElfMachine
ehEntry :: WordXX a
ehFlags :: Word32
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
.. }) <- ElfListXX a -> m (ElfXX 'Header a)
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' = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align (Doc () -> Doc ()) -> ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> m [Doc ()] -> m (Doc ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t' :: ElfNodeType). ElfXX t' a -> m (Doc ()))
-> ElfListXX a -> m [Doc ()]
forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList ElfXX t' a -> m (Doc ())
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 {} =
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> [([Char], Doc ())] -> Doc ()
forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"header"
                [ ([Char]
"Class",      ElfClass -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ElfClass -> Doc ()) -> ElfClass -> Doc ()
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a)
                , ([Char]
"Data",       ElfData -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfData
ehData       ) -- ElfData
                , ([Char]
"OSABI",      ElfOSABI -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfOSABI
ehOSABI      ) -- ElfOSABI
                , ([Char]
"ABIVersion", Word8 -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow Word8
ehABIVersion ) -- Word8
                , ([Char]
"Type",       ElfType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfType
ehType       ) -- ElfType
                , ([Char]
"Machine",    ElfMachine -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfMachine
ehMachine    ) -- ElfMachine
                , ([Char]
"Entry",      WordXX a -> Doc ()
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
esName :: [Char]
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: 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]
..} =
            let
                printSection' :: Doc () -> Doc () -> Doc ()
printSection' Doc ()
sectionTitle Doc ()
dataDoc = Doc () -> [([Char], Doc ())] -> Doc ()
forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock (Doc ()
sectionTitle Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ElfSectionIndex -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
esN :: Word) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes ([Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
esName))
                    [ ([Char]
"Type",       ElfSectionType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSectionType
esType          )
                    , ([Char]
"Flags",      [ElfSectionFlag] -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSectionFlag] -> Doc ()) -> [ElfSectionFlag] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ElfSectionFlag -> [ElfSectionFlag]
forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSectionFlag
esFlags )
                    , ([Char]
"Addr",       WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
esAddr      )
                    , ([Char]
"AddrAlign",  WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
esAddrAlign )
                    , ([Char]
"EntSize",    WordXX a -> Doc ()
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 :: WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
.. } ->
                        Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"section" (Doc ()
"NoBits:" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WordXX a -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow WordXX a
esdSize)
                    ElfSectionData a
ElfSectionDataStringTable ->
                        Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc ()
"string table section" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow (ElfSectionIndex -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ElfSectionIndex
esN :: Word) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes ([Char] -> Doc ()
forall ann. [Char] -> Doc ann
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 <- ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
parseSymbolTable ElfData
ehData ElfXX t' a
ElfXX 'Section a
s ElfListXX a
elfs
                                Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"symbol table section" (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ if [ElfSymbolXX a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ElfSymbolXX a]
stes then Doc ()
"" else Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Bool -> [ElfSymbolXX a] -> Doc ()
forall (a :: ElfClass).
SingElfClassI a =>
Bool -> [ElfSymbolXX a] -> Doc ()
printElfSymbolTable Bool
full [ElfSymbolXX a]
stes)
                            else if ElfMachine
ehMachine ElfMachine -> ElfMachine -> Bool
forall a. Eq a => a -> a -> Bool
== ElfMachine
EM_AARCH64
                                    Bool -> Bool -> Bool
&& ElfData
ehData ElfData -> ElfData -> Bool
forall a. Eq a => a -> a -> Bool
== ElfData
ELFDATA2LSB
                                    Bool -> Bool -> Bool
&& ElfSectionType
esType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_RELA
                                 Bool -> Bool -> Bool
&& WordXX a
esEntSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
== WordXX a
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" (Doc () -> Doc ()) -> m (Doc ()) -> m (Doc ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Word32 -> ElfListXX 'ELFCLASS64 -> ByteString -> m (Doc ())
forall (m :: * -> *).
MonadThrow m =>
Bool -> Word32 -> ElfListXX 'ELFCLASS64 -> ByteString -> m (Doc ())
printRelocationTableA_AARCH64 Bool
full Word32
esLink ElfListXX a
ElfListXX 'ELFCLASS64
elfs ByteString
bs
                                        SingElfClass a
SELFCLASS32 -> $Int
[Char]
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Loc -> [Char] -> m (Doc ())
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"invalid ELF: EM_AARCH64 and ELFCLASS32"
                            else
                                Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> Doc () -> Doc ()
printSection' Doc ()
"section" (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> Doc ()
printData Bool
full ByteString
bs
        printElf'' ElfSegment{ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epType :: ElfSegmentType
epFlags :: ElfSegmentFlag
epVirtAddr :: WordXX a
epPhysAddr :: WordXX a
epAddMemSize :: WordXX a
epAlign :: WordXX a
epData :: 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
..} = do
            Doc ()
dataDoc <- case ElfListXX a
epData of
                ElfListXX a
ElfListNull -> Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
""
                ElfListXX a
_ -> do
                    Doc ()
dataDoc' <- ElfListXX a -> m (Doc ())
printElf' ElfListXX a
epData
                    Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 Doc ()
dataDoc'
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> [([Char], Doc ())] -> Doc ()
forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"segment"
                [ ([Char]
"Type",       ElfSegmentType -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ElfSegmentType
epType         )
                , ([Char]
"Flags",      [ElfSegmentFlag] -> Doc ()
forall a ann. Show a => a -> Doc ann
viaShow ([ElfSegmentFlag] -> Doc ()) -> [ElfSegmentFlag] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ElfSegmentFlag -> [ElfSegmentFlag]
forall w. (Num w, FiniteBits w) => w -> [w]
splitBits ElfSegmentFlag
epFlags )
                , ([Char]
"VirtAddr",   WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epVirtAddr )
                , ([Char]
"PhysAddr",   WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epPhysAddr )
                , ([Char]
"AddMemSize", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epAddMemSize )
                , ([Char]
"Align",      WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
epAlign    )
                , ([Char]
"Data",       Doc ()
dataDoc                )
                ]
        printElf'' ElfXX t' a
ElfSectionTable = Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
"section table"
        printElf'' ElfXX t' a
ElfSegmentTable = Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
"segment table"
        printElf'' ElfRawData{ByteString
edData :: ByteString
edData :: forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
..} =
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> [([Char], Doc ())] -> Doc ()
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
eaOffset :: WordXX a
eaAlign :: WordXX a
eaAlign :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
..} =
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc () -> m (Doc ())) -> Doc () -> m (Doc ())
forall a b. (a -> b) -> a -> b
$ Doc () -> [([Char], Doc ())] -> Doc ()
forall a. Doc a -> [([Char], Doc a)] -> Doc a
formatPairsBlock Doc ()
"raw align"
                [ ([Char]
"Offset", WordXX a -> Doc ()
forall (a :: ElfClass). SingElfClassI a => WordXX a -> Doc ()
printWordXX WordXX a
eaOffset )
                , ([Char]
"Align",  WordXX a -> Doc ()
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 -> Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc ()
""
        Just (ByteString
bs', Word8
e) -> do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ $Int
[Char]
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Loc -> [Char] -> m ()
forall (m :: * -> *) a. MonadThrow m => Loc -> [Char] -> m a
chainedError [Char]
"string table should end with 0"
            Doc () -> m (Doc ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return if ByteString -> Int64
BSL.length ByteString
bs' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
                then Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
angles Doc ()
""
                else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> Doc ()) -> [[Char]] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
angles (Doc () -> Doc ()) -> ([Char] -> Doc ()) -> [Char] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc ()
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) ([[Char]] -> [Doc ()]) -> [[Char]] -> [Doc ()]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
L.sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (ByteString -> [Char]) -> [ByteString] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> [Char]
BSL8.unpack ([ByteString] -> [[Char]]) -> [ByteString] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> [ByteString]
BSL.splitWith (Word8 -> Word8 -> Bool
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 = StrictByteString -> ByteString
BSL.fromStrict (StrictByteString -> ByteString)
-> IO StrictByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO StrictByteString
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 <- ByteString -> IO Elf
forall (m :: * -> *). MonadCatch m => ByteString -> m Elf
parseElf ByteString
bs
    Doc ()
doc <- Elf -> IO (Doc ())
forall (m :: * -> *). MonadThrow m => Elf -> m (Doc ())
printElf Elf
e
    [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
o IOMode
WriteMode (\ Handle
h -> Handle -> Doc () -> IO ()
forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
h (Doc ()
doc Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
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 <- ByteString -> IO Headers
forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs
    Doc ()
doc <- Headers -> ByteString -> IO (Doc ())
forall (m :: * -> *).
MonadCatch m =>
Headers -> ByteString -> m (Doc ())
printLayout Headers
hdrs ByteString
bs
    [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
o IOMode
WriteMode (\ Handle
h -> Handle -> Doc () -> IO ()
forall ann. Handle -> Doc ann -> IO ()
hPutDoc Handle
h (Doc ()
doc Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
line))