dwarfadt 0.4 → 0.6

raw patch · 7 files changed

+120/−103 lines, 7 filesdep +textdep +text-showdep ~basedep ~dwarf-eldep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: text, text-show

Dependency ranges changed: base, dwarf-el, lens

API changes (from Hackage documentation)

Files

• dumpdwarf.hs +3/−3
• dwarfadt.cabal +3/−3
• src/Data/Dwarf/ADT.hs +42/−41
• src/Data/Dwarf/ADT/Pretty.hs +24/−19
• src/Data/Dwarf/AttrGetter.hs +25/−20
• src/Data/Dwarf/Elf.hs +13/−9
• src/Data/Dwarf/Lens.hs +10/−8

@@ -1,9 +1,9 @@ module Main(main) where -import Data.Dwarf.Elf (loadElfDwarf)-import Data.Tree (Tree(..), drawTree)-import System.Environment (getArgs) import qualified Data.Dwarf as Dwarf+import           Data.Dwarf.Elf (loadElfDwarf)+import           Data.Tree (Tree(..), drawTree)+import           System.Environment (getArgs)  dieTree :: Dwarf.DIE -> Tree Dwarf.DIE dieTree die = Node die . map dieTree $ Dwarf.dieChildren die

@@ -1,5 +1,5 @@ name:                dwarfadt-version:             0.4+version:             0.6 synopsis:            High-level wrapper around the dwarf library description:         dwarf is an excellent library to read dwarf files, but the output of                      parsing dwarf is very low-level and difficult to work with.@@ -27,9 +27,9 @@   other-modules:       Data.Dwarf.AttrGetter                      , Data.Dwarf.Lens   build-depends:       base >=4 && <5, elf >=0.27-                     , bytestring-mmap >=0.2, dwarf-el >=0.2.1 && <0.3, lens >=3.9 && <4.3+                     , bytestring-mmap >=0.2, dwarf-el >=0.3, lens >=3.9 && <4.17                      , bytestring >=0.9, containers >= 0.3, transformers >= 0.3-                     , pretty >= 1.1+                     , pretty >= 1.1, text, text-show   ghc-options:         -Wall  executable dumpdwarf

@@ -25,36 +25,37 @@   , Variable(..)   ) where -import Control.Applicative (Applicative(..), (<$>))-import Control.Lens (Lens')-import Control.Lens.Operators-import Control.Lens.Tuple-import Control.Monad (when)-import Control.Monad.Fix (MonadFix, mfix)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT(..))-import Control.Monad.Trans.State (StateT, evalStateT)-import Control.Monad.Trans.Writer (Writer, runWriter)-import Data.Dwarf (DieID, DIEMap, DIE(..), DW_TAG(..), DW_AT(..), DW_ATVAL(..))-import Data.Dwarf.AttrGetter (AttrGetterT)-import Data.Dwarf.Lens (_ATVAL_INT, _ATVAL_UINT, _ATVAL_REF, _ATVAL_STRING, _ATVAL_BOOL)-import Data.Int (Int64)-import Data.List (intercalate)-import Data.Map (Map)-import Data.Maybe (maybeToList)-import Data.Traversable (traverse)-import Data.Word (Word, Word64)+import           Control.Applicative (Applicative(..), (<$>))+import           Control.Lens (Lens')+import           Control.Lens.Operators+import           Control.Lens.Tuple+import           Control.Monad (when)+import           Control.Monad.Fix (MonadFix, mfix)+import           Control.Monad.Trans.Class (lift)+import           Control.Monad.Trans.Reader (ReaderT(..)) import qualified Control.Monad.Trans.Reader as Reader+import           Control.Monad.Trans.State (StateT, evalStateT) import qualified Control.Monad.Trans.State as State+import           Control.Monad.Trans.Writer (Writer, runWriter) import qualified Control.Monad.Trans.Writer as Writer+import           Data.Dwarf (DieID, DIEMap, DIE(..), DW_TAG(..), DW_AT(..), DW_ATVAL(..)) import qualified Data.Dwarf as Dwarf+import           Data.Dwarf.AttrGetter (AttrGetterT) import qualified Data.Dwarf.AttrGetter as AttrGetter+import           Data.Dwarf.Lens (_ATVAL_INT, _ATVAL_UINT, _ATVAL_REF, _ATVAL_STRING, _ATVAL_BOOL)+import           Data.Int (Int64)+import           Data.List (intercalate)+import           Data.Map (Map) import qualified Data.Map as Map+import           Data.Maybe (maybeToList)+import           Data.Text (Text)+import           Data.Traversable (traverse)+import           Data.Word (Word, Word64) -getName :: Monad m => AttrGetterT m String+getName :: Monad m => AttrGetterT m Text getName = AttrGetter.getAttr DW_AT_name _ATVAL_STRING -getMName :: Monad m => AttrGetterT m (Maybe String)+getMName :: Monad m => AttrGetterT m (Maybe Text) getMName = AttrGetter.findAttr DW_AT_name _ATVAL_STRING  data Warning = Warning@@ -139,7 +140,7 @@     where       toList x = maybeToList $ fmap show x -getDecl :: (Monad m, Applicative m) => AttrGetterT m Decl+getDecl :: Monad m => AttrGetterT m Decl getDecl =   Decl   <$> getUINT DW_AT_decl_file@@ -148,10 +149,10 @@   where     getUINT = (`AttrGetter.findAttr` _ATVAL_UINT) -getByteSize :: (Monad m, Applicative m) => AttrGetterT m Word+getByteSize :: Monad m => AttrGetterT m Word getByteSize = fromIntegral <$> AttrGetter.getAttr DW_AT_byte_size _ATVAL_UINT -getMByteSize :: (Monad m, Applicative m) => AttrGetterT m (Maybe Word)+getMByteSize :: Monad m => AttrGetterT m (Maybe Word) getMByteSize = fmap fromIntegral <$> AttrGetter.findAttr DW_AT_byte_size _ATVAL_UINT  data Boxed a = Boxed@@ -174,10 +175,10 @@ data BaseType = BaseType   { btByteSize :: Word   , btEncoding :: Dwarf.DW_ATE-  , btName :: Maybe String+  , btName :: Maybe Text   } deriving (Eq, Ord, Show) -parseBaseType :: (Monad m, Applicative m) => AttrGetterT m BaseType+parseBaseType :: Monad m => AttrGetterT m BaseType parseBaseType =   BaseType   <$> getByteSize@@ -189,7 +190,7 @@ -- DW_AT_decl_line=(DW_ATVAL_UINT 149) -- DW_AT_type=(DW_ATVAL_REF (DieID 62))} data Typedef = Typedef-  { tdName :: String+  { tdName :: Text   , tdDecl :: Decl   , tdType :: TypeRef   } deriving (Eq, Ord)@@ -247,7 +248,7 @@ -- DW_AT_type=(DW_ATVAL_REF (DieID 221)) -- DW_AT_data_member_location=(DW_ATVAL_BLOB "#\NUL") data Member loc = Member-  { membName :: Maybe String+  { membName :: Maybe Text   , membDecl :: Decl   , membLoc :: loc   , membType :: TypeRef@@ -273,7 +274,7 @@ -- DW_AT_decl_file=(DW_ATVAL_UINT 6) -- DW_AT_decl_line=(DW_ATVAL_UINT 79) data StructureType = StructureType-  { stName :: Maybe String+  { stName :: Maybe Text   , stByteSize :: Maybe Word -- Does not exist for forward-declarations   , stDecl :: Decl   , stIsDeclaration :: Bool -- is forward-declaration@@ -339,7 +340,7 @@ -- DW_AT_decl_file=(DW_ATVAL_UINT 6) -- DW_AT_decl_line=(DW_ATVAL_UINT 96) data UnionType = UnionType-  { unionName :: Maybe String+  { unionName :: Maybe Text   , unionByteSize :: Word   , unionDecl :: Decl   , unionMembers :: [Boxed (Member (Maybe MemberLocation))]@@ -360,7 +361,7 @@ -- DW_AT_name=(DW_ATVAL_STRING "_SC_ARG_MAX") -- DW_AT_const_value=(DW_ATVAL_INT 0) data Enumerator = Enumerator-  { enumeratorName :: String+  { enumeratorName :: Text   , enumeratorConstValue :: Int64   } deriving (Eq, Ord, Show) @@ -375,7 +376,7 @@ -- DW_AT_decl_file=(DW_ATVAL_UINT 11) -- DW_AT_decl_line=(DW_ATVAL_UINT 74) data EnumerationType = EnumerationType-  { enumName :: Maybe String+  { enumName :: Maybe Text   , enumDecl :: Decl   , enumByteSize :: Word   , enumEnumerators :: [Boxed Enumerator]@@ -391,7 +392,7 @@  -- DW_AT_type=(DW_ATVAL_REF (DieID 119)) data FormalParameter = FormalParameter-  { formalParamName :: Maybe String+  { formalParamName :: Maybe Text   , formalParamDecl :: Decl   , formalParamLocation :: Maybe Loc   , formalParamType :: TypeRef@@ -565,7 +566,7 @@   = SubprogramChildDef Def   | SubprogramChildLexicalBlock LexicalBlock -- TODO: Lexical blocks don't quite have everything a subprogram does   | SubprogramChildInlinedSubroutine InlinedSubroutine-  | SubprogramChildLocalVariable (Variable (Maybe String))+  | SubprogramChildLocalVariable (Variable (Maybe Text))   | SubprogramChildLabel -- TODO: Label content   | SubprogramChildOther DW_TAG   deriving (Eq, Ord, Show)@@ -581,7 +582,7 @@   SubprogramChildOther _ -> []  data Subprogram = Subprogram-  { subprogName :: Maybe String -- abstract-origin subprograms are anonymous+  { subprogName :: Maybe Text -- abstract-origin subprograms are anonymous   , subprogType :: TypeRef   , subprogFormalParameters :: FormalParameters   , subprogDecl :: Decl@@ -593,7 +594,7 @@   , subprogInline :: Maybe InlineType   , subprogDeclaration :: Bool   , subprogArtificial :: Bool-  , subprogLinkageName :: Maybe String+  , subprogLinkageName :: Maybe Text   , subprogChildren :: [Boxed SubprogramChild]   } deriving (Eq, Ord, Show) @@ -664,7 +665,7 @@ data Def   = DefType DefType   | DefSubprogram Subprogram-  | DefVariable (Variable String)+  | DefVariable (Variable Text)   deriving (Eq, Ord, Show)  parseDefTypeI :: DIE -> M (Boxed DefType)@@ -701,15 +702,15 @@ -- DW_AT_high_pc=(DW_ATVAL_UINT 135646754) -- DW_AT_stmt_list=(DW_ATVAL_UINT 0) data CompilationUnit = CompilationUnit-  { cuProducer :: String+  { cuProducer :: Text   , cuLanguage :: Dwarf.DW_LANG-  , cuName :: String-  , cuCompDir :: String+  , cuName :: Text+  , cuCompDir :: Text   , cuLowPc :: Word64   , cuHighPc :: Maybe Word64   , cuMRanges :: Maybe Word64   , cuStmtList :: Word64 -- TODO: Parse this further---  , cuLineNumInfo :: ([String], [Dwarf.DW_LNE])+--  , cuLineNumInfo :: ([Text], [Dwarf.DW_LNE])   , cuDefs :: [Boxed Def]   } deriving (Show) 

@@ -1,13 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Data.Dwarf.ADT.Pretty (compilationUnit, dwarf) where -import Control.Applicative ((<$>))-import Data.Dwarf (DW_ATE(..))-import Data.Dwarf.ADT (Boxed(..), Def(..), DefType(..))-import Data.Maybe (mapMaybe)-import Text.PrettyPrint ((<>))+import           Control.Applicative ((<$>))+import           Data.Dwarf (DW_ATE(..))+import           Data.Dwarf.ADT (Boxed(..), Def(..), DefType(..)) import qualified Data.Dwarf.ADT as ADT import qualified Data.List as List+import           Data.Maybe (mapMaybe)+import           Data.Text (Text)+import qualified Data.Text as Text+import           Text.PrettyPrint ((<>)) import qualified Text.PrettyPrint as PP  showPP :: Show a => a -> PP.Doc@@ -32,18 +34,21 @@ ppATE DW_ATE_unsigned_fixed = "unsigned_fixed" ppATE DW_ATE_decimal_float = "decimal_float" +text :: Text -> PP.Doc+text = PP.text . Text.unpack+ baseTypeName :: ADT.BaseType -> PP.Doc-baseTypeName (ADT.BaseType _ _ (Just name)) = PP.text name+baseTypeName (ADT.BaseType _ _ (Just name)) = text name baseTypeName (ADT.BaseType _ encoding Nothing) = ppATE encoding -withName :: PP.Doc -> Maybe String -> PP.Doc+withName :: PP.Doc -> Maybe Text -> PP.Doc withName prefix Nothing = prefix-withName prefix (Just name) = prefix <> " " <> PP.text name+withName prefix (Just name) = prefix <> " " <> text name  indent :: PP.Doc -> PP.Doc indent x = "  " <> x -compositeMembers :: PP.Doc -> Maybe String -> [Boxed (ADT.Member a)] -> PP.Doc+compositeMembers :: PP.Doc -> Maybe Text -> [Boxed (ADT.Member a)] -> PP.Doc compositeMembers prefix mName members =   PP.vcat   [ withName prefix mName <> " {"@@ -78,7 +83,7 @@   ]   where     enumeratorPP Boxed { bData = enumerator } = PP.hcat-      [ PP.text $ ADT.enumeratorName enumerator+      [ text $ ADT.enumeratorName enumerator       , " = "       , showPP $ ADT.enumeratorConstValue enumerator       , ","@@ -97,12 +102,12 @@         }       } = ppType name t -ppType :: Maybe String -> ADT.TypeRef -> PP.Doc+ppType :: Maybe Text -> ADT.TypeRef -> PP.Doc ppType mName = result . recurseType   where     result (baseType, decl) = baseType <> PP.space <> decl Nothing (nameCont mName)     nameCont Nothing = id-    nameCont (Just name) = (<> PP.text name)+    nameCont (Just name) = (<> text name)     addAnnotation onPrecedence f innerDecl outerPrecedence cont =       innerDecl innerPrecedence $ f . p . cont       where@@ -118,17 +123,17 @@     recurseType (ADT.TypeRef Boxed { bData = typ }) =       case typ of       DefBaseType x -> mkBaseType $ baseTypeName x-      DefTypedef x -> mkBaseType . PP.text $ ADT.tdName x+      DefTypedef x -> mkBaseType . text $ ADT.tdName x       DefStructureType ADT.StructureType { ADT.stName = Just name } ->-        mkBaseType $ "struct " <> PP.text name+        mkBaseType $ "struct " <> text name       DefStructureType x@ADT.StructureType { ADT.stName = Nothing } ->         mkBaseType $ structureType x       DefUnionType ADT.UnionType { ADT.unionName = Just name } ->-        mkBaseType $ "union " <> PP.text name+        mkBaseType $ "union " <> text name       DefUnionType x@ADT.UnionType { ADT.unionName = Nothing } ->         mkBaseType $ unionType x       DefEnumerationType ADT.EnumerationType { ADT.enumName = Just name } ->-        mkBaseType $ "enum " <> PP.text name+        mkBaseType $ "enum " <> text name       DefEnumerationType x@ADT.EnumerationType { ADT.enumName = Nothing } ->         mkBaseType $ enumerationType x @@ -161,11 +166,11 @@  lexicalBlock :: ADT.LexicalBlock -> PP.Doc lexicalBlock (ADT.LexicalBlock _ _ _ s) =-  PP.text "lexical block " <> defSubprogram s+  "lexical block " <> defSubprogram s  inlinedSubroutine :: ADT.InlinedSubroutine -> PP.Doc inlinedSubroutine (ADT.InlinedSubroutine _ _ _ _ s) =-  PP.text "inlined " <> defSubprogram s+  "inlined " <> defSubprogram s  subprogChild :: Boxed ADT.SubprogramChild -> Maybe PP.Doc subprogChild (Boxed dId dat) =@@ -196,7 +201,7 @@   where     m = maybe "" showPP -defVariable :: (name -> Maybe String) -> ADT.Variable name -> PP.Doc+defVariable :: (name -> Maybe Text) -> ADT.Variable name -> PP.Doc defVariable f ADT.Variable   { ADT.varName = name, ADT.varType = typeRef } = ppType (f name) typeRef 

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-} module Data.Dwarf.AttrGetter   ( AttrGetterT, run   , findAttrVals, findAttrVal@@ -6,20 +6,24 @@   , getAttr   ) where -import Control.Applicative (Applicative(..), (<$>))-import Control.Lens ((^?))-import Control.Monad (liftM)-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Trans.Reader (ReaderT(..))-import Control.Monad.Trans.State (StateT(..))-import Data.Dwarf (DIE(..), DW_AT, DW_ATVAL)-import Data.List (partition)-import Data.Maybe (fromMaybe)+import           Control.Applicative (Applicative(..), (<$>))+import           Control.Lens ((^?))+import           Control.Monad (liftM)+import           Control.Monad.Trans.Class (MonadTrans(..))+import           Control.Monad.Trans.Reader (ReaderT(..)) import qualified Control.Monad.Trans.Reader as Reader+import           Control.Monad.Trans.State (StateT(..)) import qualified Control.Monad.Trans.State as State+import           Data.Dwarf (DIE(..), DW_AT, DW_ATVAL) import qualified Data.Dwarf.Lens as DwarfLens+import           Data.List (partition)+import           Data.Maybe (fromMaybe)+import           Data.Monoid ((<>))+import           Data.Text (Text)+import qualified Data.Text as Text+import           TextShow (TextShow(..)) -newtype AttrGetterT m a = AttrGetterT (ReaderT String (StateT [(DW_AT, DW_ATVAL)] m) a)+newtype AttrGetterT m a = AttrGetterT (ReaderT Text (StateT [(DW_AT, DW_ATVAL)] m) a)   deriving (Functor, Applicative, Monad)  instance MonadTrans AttrGetterT where@@ -28,10 +32,10 @@ run :: DIE -> AttrGetterT m a -> m (a, [(DW_AT, DW_ATVAL)]) run die (AttrGetterT act) =   (`runStateT` dieAttributes die) .-  (`runReaderT` (" in " ++ show die)) $+  (`runReaderT` (" in " <> showt die)) $   act -getSuffix :: Monad m => AttrGetterT m String+getSuffix :: Monad m => AttrGetterT m Text getSuffix = AttrGetterT Reader.ask  findAttrVals :: Monad m => DW_AT -> AttrGetterT m [DW_ATVAL]@@ -49,19 +53,19 @@       return $ Just val     _ -> return Nothing -getATVal :: String -> String -> DwarfLens.ATVAL_NamedPrism a -> DW_ATVAL -> a+getATVal :: Text -> Text -> DwarfLens.ATVAL_NamedPrism a -> DW_ATVAL -> a getATVal prefix suffix (typName, typ) atval =   fromMaybe (error msg) $ atval ^? typ   where-    msg = concat [prefix, " is: ", show atval, " but expected: ", typName, suffix]+    msg = Text.unpack $ mconcat [prefix, " is: ", showt atval, " but expected: ", typName, suffix]  toVal ::-  (Monad m, Functor f, Show a) =>+  (Monad m, Functor f, TextShow a) =>   (a -> AttrGetterT m (f DW_ATVAL)) ->   a -> DwarfLens.ATVAL_NamedPrism b -> AttrGetterT m (f b) toVal finder at prism = do   suffix <- getSuffix-  (liftM . fmap) (getATVal (show at) suffix prism) $ finder at+  (liftM . fmap) (getATVal (showt at) suffix prism) $ finder at  findAttrs :: Monad m => DW_AT -> DwarfLens.ATVAL_NamedPrism a -> AttrGetterT m [a] findAttrs = toVal findAttrVals@@ -71,6 +75,7 @@  getAttr :: Monad m => DW_AT -> DwarfLens.ATVAL_NamedPrism a -> AttrGetterT m a getAttr at prism = do-  suffix <- getSuffix-  (liftM . fromMaybe . error) ("Could not find " ++ show at ++ suffix) $-    findAttr at prism+    suffix <- getSuffix+    (liftM . fromMaybe . error . Text.unpack)+        ("Could not find " <> showt at <> suffix) $+        findAttr at prism

@@ -1,23 +1,27 @@+{-# LANGUAGE OverloadedStrings #-} module Data.Dwarf.Elf   ( loadElfDwarf   , elfSectionByName   , parseElfDwarfADT   ) where -import Control.Applicative (Applicative(..), (<$>))-import Data.Dwarf.ADT (Dwarf)-import Data.Elf (parseElf, Elf(..), ElfSection(..))-import Data.List (find)-import System.IO.Posix.MMap (unsafeMMapFile)+import           Control.Applicative (Applicative(..), (<$>)) import qualified Data.ByteString as BS import qualified Data.Dwarf as Dwarf+import           Data.Dwarf.ADT (Dwarf) import qualified Data.Dwarf.ADT as Dwarf.ADT+import           Data.Elf (parseElf, Elf(..), ElfSection(..))+import           Data.List (find)+import           Data.Monoid ((<>))+import           Data.Text (Text)+import qualified Data.Text as Text+import           System.IO.Posix.MMap (unsafeMMapFile) -elfSectionByName :: Elf -> String -> Either String BS.ByteString+elfSectionByName :: Elf -> Text -> Either Text BS.ByteString elfSectionByName elf name =-  maybe (Left ("Missing section " ++ name)) Right .+  maybe (Left ("Missing section " <> name)) Right .   fmap elfSectionData .-  find ((== name) . elfSectionName) $ elfSections elf+  find ((== name) . Text.pack . elfSectionName) $ elfSections elf  loadElfDwarf :: Dwarf.Endianess -> FilePath -> IO (Elf, ([Dwarf.DIE], Dwarf.DIEMap)) loadElfDwarf endianess filename = do@@ -25,7 +29,7 @@   let elf = parseElf bs       get = elfSectionByName elf   sections <--    either fail return $+    either (fail . Text.unpack) return $     Dwarf.Sections     <$> get ".debug_info"     <*> get ".debug_abbrev"

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Data.Dwarf.Lens   ( _DW_ATVAL_INT, _ATVAL_INT@@ -9,17 +10,18 @@   , ATVAL_NamedPrism   ) where -import Control.Lens (Getting)-import Control.Lens.TH (makePrisms)-import Data.Dwarf (DieID, DW_ATVAL)-import Data.Int (Int64)-import Data.Word (Word64)+import           Control.Lens (Getting)+import           Control.Lens.TH (makePrisms) import qualified Data.ByteString as BS+import           Data.Dwarf (DieID, DW_ATVAL)+import           Data.Int (Int64) import qualified Data.Monoid as Monoid+import           Data.Text (Text)+import           Data.Word (Word64) -{-# ANN module "HLint: ignore Use camelCase" #-}+{-# ANN module ("HLint: ignore Use camelCase"::String) #-} -type ATVAL_NamedPrism a = (String, Getting (Monoid.First a) DW_ATVAL a)+type ATVAL_NamedPrism a = (Text, Getting (Monoid.First a) DW_ATVAL a)  makePrisms ''DW_ATVAL @@ -32,7 +34,7 @@ _ATVAL_REF :: ATVAL_NamedPrism DieID _ATVAL_REF = ("ATVAL_REF", _DW_ATVAL_REF) -_ATVAL_STRING :: ATVAL_NamedPrism String+_ATVAL_STRING :: ATVAL_NamedPrism Text _ATVAL_STRING = ("ATVAL_STRING", _DW_ATVAL_STRING)  _ATVAL_BLOB :: ATVAL_NamedPrism BS.ByteString