Use parsers returning an Either as constructors

This change allows the main program to accept a single parser type
as input, allowing string arguments to be converted to the correct
type or raise an informative error message. This is instead of
passing a validating reader and a separate parser.

Author: ajdawson

app/Bin32.hs

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

app/Bin64.hs

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

app/Dec32.hs

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

app/Dec64.hs

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

app/Hex32.hs

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

app/Hex64.hs

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

fp-truncate.cabal

@@ -23,7 +23,6 @@ library
     hs-source-dirs:      src
     exposed-modules:     Truncate
                        , Truncate.Main
-                       , Truncate.Main.Readers
                        , Truncate.Internal
     build-depends:       base >= 4.7 && < 5
                        , data-binary-ieee754
@@ -88,6 +87,9 @@ test-suite fp-truncate-test
                        , Truncate.Test.Truncatable.FromBits
                        , Truncate.Test.Truncatable.MakeBits
                        , Truncate.Test.Truncatable.Operator
+                       , Truncate.Test.Binary
+                       , Truncate.Test.Decimal
+                       , Truncate.Test.Hexadecimal
                        , Truncate.Internal.Test.TruncateWord
                        , Test.Truncate.Arbitrary
     build-depends:       base

src/Truncate.hs

@@ -25,6 +25,7 @@ You can create additional representations by making instances of the
 --
 module Truncate
     ( Truncatable(..)
+    , TParser
     , WordF(..)
     , Binary(..)
     , Decimal(..)
@@ -51,6 +52,7 @@ import Data.Binary.IEEE754 ( wordToFloat
 import Numeric             ( readInt
                            , readHex
                            )
+import Text.Read           (readMaybe)
 
 
 ------------------------------------------------------------------------
@@ -82,6 +84,11 @@ class Truncatable a where
     convert = fromBits . makeBits
 
 
+-----------------------------------------------------------------------
+-- | A function type for parsing 'Truncatable' types
+type TParser a = String -> Either String a
+
+
 -----------------------------------------------------------------------
 -- | Truncatable floating-point numbers in binary representation.
 data Binary = Bin32 String
@@ -108,17 +115,19 @@ toBin = convert
 
 -- | Create a 'Bin32' from a string. The string should be a sequence of the
 -- characters @0@ and @1@ no longer than 32 characters in length.
-makeBin32 :: String -> Binary
+makeBin32 :: TParser Binary
 makeBin32 s
-  | length s <= 32 && validBin s = Bin32 s
-  | otherwise                    = error $ "invalid 32-bit binary: " ++ s
+  | length s > 32     = Left $ tooManyDigits "binary" 32
+  | (not .validBin) s = Left $ invalidDigits "binary" 32
+  | otherwise         = Right (Bin32 s)
 
 -- | Create a 'Bin64' from a string. The string should be a sequence of the
 -- characters @0@ and @1@ no longer than 64 characters in length.
-makeBin64 :: String -> Binary
+makeBin64 :: TParser Binary
 makeBin64 s
-  | length s <= 64 && validBin s = Bin64 s
-  | otherwise                    = error $ "invalid 64-bit binary: " ++ s
+  | length s > 64     = Left $ tooManyDigits "binary" 64
+  | (not .validBin) s = Left $ invalidDigits "binary" 64
+  | otherwise = Right (Bin64 s)
 
 
 -----------------------------------------------------------------------
@@ -143,13 +152,17 @@ toDec = convert
 
 -- | Create a 'Dec32' from a string. The string can be anything that can be
 -- interpreted as a 32-bit 'Float' by 'read'.
-makeDec32 :: String -> Decimal
-makeDec32 s = Dec32 (read s :: Float)
+makeDec32 :: TParser Decimal
+makeDec32 s = case readMaybe s :: Maybe Float of
+    Just f  -> Right (Dec32 f)
+    Nothing -> Left "Error: value is not a 32-bit decimal number"
 
 -- | Create a 'Dec64' from a string. The string can be anything that can be
 -- interpreted as a 64-bit 'Double' by 'read'.
-makeDec64 :: String -> Decimal
-makeDec64 s = Dec64 (read s :: Double)
+makeDec64 :: TParser Decimal
+makeDec64 s = case readMaybe s :: Maybe Double of
+    Just f  -> Right (Dec64 f)
+    Nothing -> Left  "Error: value is not a 64-bit decimal number"
 
 
 -----------------------------------------------------------------------
@@ -178,14 +191,16 @@ toHex = convert
 
 -- | Create a 'Hex32' from a string. The string should be a sequence of the
 -- valid hexadecimal digits @0-9@ and @a-f@ no longer than 8 characters in length.
-makeHex32 :: String -> Hexadecimal
+makeHex32 :: TParser Hexadecimal
 makeHex32 s
-  | length s <= 8 && validHex s = Hex32 s
-  | otherwise                   = error $ "invalid 32-bit hexadecimal: " ++ s
+  | length s > 8       = Left $ tooManyDigits "hexadecimal" 32
+  | (not . validHex) s = Left $ invalidDigits "hexadecimal" 32
+  | otherwise          = Right (Hex32 s)
 
 -- | Create a 'Hex64' from a string. The string should be a sequence of the
 -- valid hexadecimal digits @0-9@ and @a-f@ no longer than 16 characters in length.
-makeHex64 :: String -> Hexadecimal
+makeHex64 :: TParser Hexadecimal
 makeHex64 s
-  | length s <= 16 && validHex s = Hex64 s
-  | otherwise                    = error $ "invalid 64-bit hexadecimal: " ++ s
+  | length s > 16      = Left $ tooManyDigits "hexadecimal" 64
+  | (not . validHex) s = Left $ invalidDigits "hexadecimal" 64
+  | otherwise          = Right (Hex64 s)

src/Truncate/Internal.hs

@@ -95,3 +95,23 @@ zeroPad n bs
 
 zeroStrip :: String -> String
 zeroStrip = dropWhile (== '0')
+
+
+------------------------------------------------------------------------
+-- generating error messages for 'TParser' functions
+
+tooManyDigits :: String -> Int -> String
+tooManyDigits name size = errmsg name size "too many digits"
+
+invalidDigits :: String -> Int -> String
+invalidDigits name size = errmsg name size "invalid digits"
+
+errmsg :: String -> Int -> String -> String
+errmsg name size reason = mconcat [ "Error: value is not a "
+                                  , (show size)
+                                  , "-bit "
+                                  , name
+                                  , " number ("
+                                  , reason
+                                  , ")"
+                                  ]

src/Truncate/Main.hs

@@ -40,6 +40,7 @@ import Options.Applicative
 
 ------------------------------------------------------------------------
 import Truncate            ( Truncatable(..)
+                           , TParser
                            , toBin
                            , toDec
                            , toHex
@@ -52,22 +53,18 @@ import Truncate            ( Truncatable(..)
 -- and print the output to stdout. This function sets the exit code to @0@
 -- on success, and @>0@ otherwise.
 btMain :: (Show b, Truncatable b)
-    => ReadM String   -- ^ A reader for the type of input required by the
-                      -- 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 parser to generate a 'Truncatable' instance from
-                      -- a string (e.g., 'makeBin32').
-    -> String         -- ^ A short (one line) description of program's purpose.
+    => TParser b  -- ^ A parser to generate a 'Truncatable' instance from
+                  -- a string (e.g., 'makeBin32').
+    -> String     -- ^ A short (one line) description of program's purpose.
     -> IO ()
-btMain reader parser description =
-    btMainWithExitCode reader parser description >>= exitWith
+btMain parser description =
+    btMainWithExitCode parser description >>= exitWith
 
 btMainWithExitCode :: (Show b, Truncatable b) =>
-    ReadM String -> (String -> b) -> String -> IO ExitCode
-btMainWithExitCode reader parser description = do
+    TParser b -> String -> IO ExitCode
+btMainWithExitCode parser description = do
     prog <- getProgName
-    let optionParser  = makeParser reader parser
+    let optionParser  = makeParser parser
         programParser = info (helper <*> optionParser)
                              (header $ prog ++ " - " ++ description)
     options <- execParser programParser
@@ -95,11 +92,11 @@ data Options a = Options { inputValue  :: a
                          }
                deriving (Show)
 
-makeParser :: ReadM a -> (a -> b) -> Parser (Options b)
-makeParser reader parser = optionParser
+makeParser :: TParser b -> Parser (Options b)
+makeParser parser = optionParser
   where
     optionParser = Options <$> valueParser <*> bitsParser <*> baseParser
-    valueParser  = parser <$> (argument reader (metavar "value"))
+    valueParser  = argument (eitherReader parser) (metavar "value")
     bitsParser   = or12 $ argument auto (metavar "bits")
     baseParser   = option auto (  short 'b'
                                <> long "base"