Add command line parser

lib/Language/Elna/Object/Elf.hs

@@ -30,17 +30,23 @@ module Language.Elna.Object.Elf
     , elf32Rel
     , elf32Rela
     , elf32Sym
+    , elfHeaderSize
     , elfIdentification
+    , elfObject
     , rInfo
     , stInfo
     ) where
 
-import Control.Exception (Exception(..))
+import Control.Exception (Exception(..), throwIO)
 import Data.Bits (Bits(..))
 import qualified Data.ByteString.Builder as ByteString.Builder
 import Data.Int (Int32)
 import Data.Word (Word8, Word16, Word32)
 import qualified Data.ByteString as ByteString
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
+import Data.Foldable (traverse_)
 
 -- * Data types.
 
@@ -345,27 +351,6 @@ instance Enum ElfSectionType
     fromEnum SHT_HIUSER = 0xffffffff
     fromEnum (ElfSectionType x) = fromIntegral x
 
--- * Help types and functions.
-
-data ByteOrder = LSB | MSB
-    deriving Eq
-
-data ElfEncodingError
-    = ElfInvalidByteOrderError
-    | ElfUnsupportedClassError ElfClass
-    deriving Eq
-
-instance Show ElfEncodingError
-  where
-    show ElfInvalidByteOrderError = "Invalid byte order."
-    show (ElfUnsupportedClassError class') =
-        concat ["Elf class \"", show class', "\" is not supported."]
-
-instance Exception ElfEncodingError
-
-fromIntegralEnum :: (Enum a, Num b) => a -> b
-fromIntegralEnum = fromIntegral . fromEnum
-
 -- * Encoding functions.
 
 elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder
@@ -462,3 +447,47 @@ stInfo binding type' = fromIntegralEnum binding `shiftL` 4
 rInfo :: Elf32_Word -> Word8 -> Elf32_Word
 rInfo symbol type' = symbol `shiftL` 8
     .|. fromIntegralEnum type'
+
+-- * Help types and functions.
+
+data ByteOrder = LSB | MSB
+    deriving Eq
+
+data ElfEncodingError
+    = ElfInvalidByteOrderError
+    | ElfUnsupportedClassError ElfClass
+    deriving Eq
+
+instance Show ElfEncodingError
+  where
+    show ElfInvalidByteOrderError = "Invalid byte order."
+    show (ElfUnsupportedClassError class') =
+        concat ["Elf class \"", show class', "\" is not supported."]
+
+instance Exception ElfEncodingError
+
+fromIntegralEnum :: (Enum a, Num b) => a -> b
+fromIntegralEnum = fromIntegral . fromEnum
+
+elfHeaderSize :: Elf32_Off
+elfHeaderSize = 52
+
+-- Writes an ELF object with the given header to the provided file path.
+-- The callback writes the sections and returns headers for those sections.
+elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO ()
+elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
+  where
+    withObjectFile objectHandle
+        = hSeek objectHandle AbsoluteSeek (fromIntegral elfHeaderSize)
+        >> putContents objectHandle
+        >>= afterContents objectHandle
+    afterContents objectHandle headers =
+        let headerEncodingResult = elf32Ehdr
+                $ header
+                    { e_shoff = elfHeaderSize + Vector.foldr ((+) . sh_size) 0 headers
+                    }
+         in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
+            >> either throwIO (putHeaders objectHandle) headerEncodingResult
+    putHeaders objectHandle encodedHeader
+        = hSeek objectHandle AbsoluteSeek 0
+        >> ByteString.Builder.hPutBuilder objectHandle encodedHeader