Merge pull request #1 from ajdawson/executable-names

Allow automatic discovery of a main program's name

Author: ajdawson

app/Bin32.hs

@@ -17,8 +17,8 @@ import Truncate              (makeBin32)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (binary)
 
-header :: String
-header = "trbin32 - Truncate 32-bit floating-point numbers represented in binary"
+description :: String
+description = "Truncate 32-bit floating-point numbers represented in binary"
 
 main :: IO ()
-main = btMain binary makeBin32 header
+main = btMain binary makeBin32 description

app/Bin64.hs

@@ -17,8 +17,8 @@ import Truncate              (makeBin64)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (binary)
 
-header :: String
-header = "trbin64 - Truncate 64-bit floating-point numbers represented in binary"
+description :: String
+description = "Truncate 64-bit floating-point numbers represented in binary"
 
 main :: IO ()
-main = btMain binary makeBin64 header
+main = btMain binary makeBin64 description

app/Dec32.hs

@@ -17,8 +17,8 @@ import Truncate              (makeDec32)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (decimal)
 
-header :: String
-header = "trdec32 - Truncate 32-bit floating-point numbers represented in decimal"
+description :: String
+description = "Truncate 32-bit floating-point numbers represented in decimal"
 
 main :: IO ()
-main = btMain decimal makeDec32 header
+main = btMain decimal makeDec32 description

app/Dec64.hs

@@ -17,8 +17,8 @@ import Truncate              (makeDec64)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (decimal)
 
-header :: String
-header = "trdec64 - truncate 64-bit floating-point numbers in decimal"
+description :: String
+description = "truncate 64-bit floating-point numbers in decimal"
 
 main :: IO ()
-main = btMain decimal makeDec64 header
+main = btMain decimal makeDec64 description

app/Hex32.hs

@@ -17,8 +17,8 @@ import Truncate              (makeHex32)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (hexadecimal)
 
-header :: String
-header = "trhex32 - Truncate 32-bit floating-point numbers represented in hexadecimal"
+description :: String
+description = "Truncate 32-bit floating-point numbers represented in hexadecimal"
 
 main :: IO ()
-main = btMain hexadecimal makeHex32 header
+main = btMain hexadecimal makeHex32 description

app/Hex64.hs

@@ -17,8 +17,8 @@ import Truncate              (makeHex64)
 import Truncate.Main         (btMain)
 import Truncate.Main.Readers (hexadecimal)
 
-header :: String
-header = "trhex64 - Truncate 64-bit floating-point numbers represented in hexadecimal"
+description :: String
+description = "Truncate 64-bit floating-point numbers represented in hexadecimal"
 
 main :: IO ()
-main = btMain hexadecimal makeHex64 header
+main = btMain hexadecimal makeHex64 description

src/Truncate/Main.hs

@@ -27,6 +27,7 @@ module Truncate.Main
 
 
 ------------------------------------------------------------------------
+import System.Environment  (getProgName)
 import System.Exit         ( ExitCode(..)
                            , exitWith
                            )
@@ -55,18 +56,22 @@ btMain :: (Show b, Truncatable b)
                       -- program for validating (but not parsing) an input value.
                       -- The 'Tuncate.Main.Readers' module provides readers for
                       -- binary, decimal and hexadecimal inputs.
-    -> (String -> b)  -- ^ A function to generate a 'Truncatable' instance from
+    -> (String -> b)  -- ^ A parser to generate a 'Truncatable' instance from
                       -- a string (e.g., 'makeBin32').
-    -> String         -- ^ A header printed as part of the program help.
+    -> String         -- ^ A short (one line) description of program's purpose.
     -> IO ()
-btMain r f h = btMainWithExitCode r f h >>= exitWith
+btMain reader parser description =
+    btMainWithExitCode reader parser description >>= exitWith
 
 btMainWithExitCode :: (Show b, Truncatable b) =>
     ReadM String -> (String -> b) -> String -> IO ExitCode
-btMainWithExitCode r f h = runProgram =<< execParser programParser
-  where
-    optionParser  = makeParser f r
-    programParser = info (helper <*> optionParser) (header h)
+btMainWithExitCode reader parser description = do
+    prog <- getProgName
+    let optionParser  = makeParser reader parser
+        programParser = info (helper <*> optionParser)
+                             (header $ prog ++ " - " ++ description)
+    options <- execParser programParser
+    runProgram options
 
 runProgram :: (Show a, Truncatable a) => Options a -> IO ExitCode
 runProgram (Options val bs b)
@@ -90,11 +95,11 @@ data Options a = Options { inputValue  :: a
                          }
                deriving (Show)
 
-makeParser :: (a -> b) -> ReadM a -> Parser (Options b)
-makeParser f r = optionParser
+makeParser :: ReadM a -> (a -> b) -> Parser (Options b)
+makeParser reader parser = optionParser
   where
     optionParser = Options <$> valueParser <*> bitsParser <*> baseParser
-    valueParser  = f <$> (argument r (metavar "value"))
+    valueParser  = parser <$> (argument reader (metavar "value"))
     bitsParser   = or12 $ argument auto (metavar "bits")
     baseParser   = option auto (  short 'b'
                                <> long "base"