Add command line parser

1 files changed, 60 insertions, 75 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 4004d5c..4d5e406 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,10 +2,9 @@ module Main
     ( main
     ) where
 
+import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
 import Language.Elna.Object.Elf
-    ( ByteOrder(..)
-    , Elf32_Ehdr(..)
-    , Elf32_Off
+    ( Elf32_Ehdr(..)
     , ElfMachine(..)
     , ElfType(..)
     , ElfVersion(..)
@@ -14,82 +13,68 @@ import Language.Elna.Object.Elf
     , ElfData(..)
     , Elf32_Shdr(..)
     , ElfSectionType(..)
-    , elf32Ehdr
-    , elf32Shdr
+    , elfHeaderSize
+    , elfObject
     )
 import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Builder as ByteString.Builder
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
-import Control.Exception (throwIO)
-import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
-import Data.Foldable (traverse_)
+import Data.Maybe (fromMaybe)
+import System.IO (Handle)
+import System.FilePath (replaceExtension, takeFileName)
 
-riscv32Elf :: FilePath -> IO ()
-riscv32Elf outFile = withFile outFile WriteMode withObjectFile
-  where
-    headerSize :: Elf32_Off
-    headerSize = 52
-    withObjectFile objectHandle
-        = hSeek objectHandle AbsoluteSeek (fromIntegral headerSize)
-        >> putContents objectHandle
-        >>= afterContents objectHandle
-    afterContents objectHandle headers =
-        let headerEncodingResult = elf32Ehdr
-                $ header
-                $ 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
-    putContents :: Handle -> IO (Vector Elf32_Shdr)
-    putContents objectHandle =
-        let stringTable = "\0shstrtab\0"
-            written = Vector.fromList
-                [ Elf32_Shdr
-                    { sh_type = SHT_NULL
-                    , sh_size = 0
-                    , sh_offset = 0
-                    , sh_name = 0
-                    , sh_link = 0
-                    , sh_info = 0
-                    , sh_flags = 0
-                    , sh_entsize = 0
-                    , sh_addralign = 0
-                    , sh_addr = 0
-                    }
-                , Elf32_Shdr
-                    { sh_type = SHT_STRTAB
-                    , sh_size = fromIntegral $ ByteString.length stringTable
-                    , sh_offset = fromIntegral headerSize
-                    , sh_name = 1
-                    , sh_link = 0
-                    , sh_info = 0
-                    , sh_flags = 0
-                    , sh_entsize = 0
-                    , sh_addralign = 0
-                    , sh_addr = 0
-                    }
-                ]
-         in ByteString.hPut objectHandle stringTable
-            >> pure written
-    header written = Elf32_Ehdr
-        { e_version = EV_CURRENT
-        , e_type = ET_REL
-        , e_shstrndx = 1 -- String table. SHN_UNDEF
-        , e_shoff = written + headerSize
-        , e_shnum = 2
-        , e_shentsize = 40
-        , e_phoff = 0
-        , e_phnum = 0
-        , e_phentsize = 32
-        , e_machine = EM_RISCV
-        , e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
-        , e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
-        , e_entry = 0
-        , e_ehsize = fromIntegral headerSize
-        }
+riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
+riscv32Elf objectHandle =
+    let stringTable = "\0shstrtab\0"
+        written = Vector.fromList
+            [ Elf32_Shdr
+                { sh_type = SHT_NULL
+                , sh_size = 0
+                , sh_offset = 0
+                , sh_name = 0
+                , sh_link = 0
+                , sh_info = 0
+                , sh_flags = 0
+                , sh_entsize = 0
+                , sh_addralign = 0
+                , sh_addr = 0
+                }
+            , Elf32_Shdr
+                { sh_type = SHT_STRTAB
+                , sh_size = fromIntegral $ ByteString.length stringTable
+                , sh_offset = fromIntegral elfHeaderSize
+                , sh_name = 1
+                , sh_link = 0
+                , sh_info = 0
+                , sh_flags = 0
+                , sh_entsize = 0
+                , sh_addralign = 0
+                , sh_addr = 0
+                }
+            ]
+        in ByteString.hPut objectHandle stringTable >> pure written
+
+riscv32Header :: Elf32_Ehdr
+riscv32Header = Elf32_Ehdr
+    { e_version = EV_CURRENT
+    , e_type = ET_REL
+    , e_shstrndx = 1 -- String table. SHN_UNDEF
+    , e_shoff = 0
+    , e_shnum = 2
+    , e_shentsize = 40
+    , e_phoff = 0
+    , e_phnum = 0
+    , e_phentsize = 32
+    , e_machine = EM_RISCV
+    , e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
+    , e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
+    , e_entry = 0
+    , e_ehsize = fromIntegral elfHeaderSize
+    }
 
 main :: IO ()
-main = riscv32Elf "here.o"
+main  = execParser commandLine >>= withCommandLine
+  where
+    withCommandLine CommandLine{..} =
+        let defaultOutput = replaceExtension (takeFileName input) "o"
+         in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf