From 10958faa61301446a980ea93cb2e77287b51a225 Mon Sep 17 00:00:00 2001 From: defanor Date: Sat, 16 Dec 2017 11:14:08 +0300 Subject: Add more instances Numeric and date/time types. --- Coalpit.hs | 151 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++- coalpit.cabal | 4 +- test/Test.hs | 8 ++-- 3 files changed, 157 insertions(+), 6 deletions(-) diff --git a/Coalpit.hs b/Coalpit.hs index 381e7be..3efd73f 100644 --- a/Coalpit.hs +++ b/Coalpit.hs @@ -83,6 +83,15 @@ import Data.Proxy import Data.Semigroup import Data.Void import qualified Data.List.NonEmpty as NE +import Data.Word +import Numeric.Natural +import Data.Int +import Data.Time.Clock +import Data.Time.Format +import Data.Time.Calendar +import Data.Time.LocalTime +import Data.Scientific +import Text.ParserCombinators.ReadP (readP_to_S) -- | Command-line argument wrapper, used to avoid orphan ShowToken @@ -139,11 +148,20 @@ data Options = Options { conNameMod :: String -> String , omitNamedOptions :: Bool -- ^ Omit named Maybe values to indicate -- 'Nothing'. + , timeLocale :: TimeLocale + , dateFormat :: String + -- ^ See "Data.Time.Format". + , timeFormat :: String + , dateTimeFormat :: String + , scientificFormat :: FPFormat + , scientificDecimals :: Maybe Int } -- | Default options. defOpt :: Options defOpt = Options (map toLower) (("--" ++) . map toLower) False True + defaultTimeLocale (iso8601DateFormat Nothing) "%H:%M:%S" + (iso8601DateFormat (Just "%H:%M:%S")) Generic Nothing -- | Coalpit class: parsing, printing, usage strings. class Coalpit a where @@ -375,6 +393,51 @@ instance Coalpit Integer where toArgs _ i = [show i] argHelper _ _ _ = "INTEGER" +instance Coalpit Word8 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "WORD8" + +instance Coalpit Word16 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "WORD16" + +instance Coalpit Word32 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "WORD32" + +instance Coalpit Word64 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "WORD64" + +instance Coalpit Int8 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "INT8" + +instance Coalpit Int16 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "INT16" + +instance Coalpit Int32 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "INT32" + +instance Coalpit Int64 where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "INT64" + +instance Coalpit Natural where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "NATURAL" + instance Coalpit Rational where argParser _ = readArg toArgs _ i = [show i] @@ -385,22 +448,106 @@ instance Coalpit Double where toArgs _ i = [show i] argHelper _ _ _ = "DOUBLE" +instance Coalpit Float where + argParser _ = readArg + toArgs _ i = [show i] + argHelper _ _ _ = "FLOAT" + +instance Coalpit Char where + argParser _ = readArg + toArgs _ c = [show c] + argHelper _ _ _ = "CHAR" + instance {-#OVERLAPPING#-} Coalpit String where argParser _ = token (Right . unArg) Nothing toArgs _ i = [i] argHelper _ _ _ = "STRING" +-- | A dot ("."). instance Coalpit () where argParser _ = pS (char '.') *> pure () toArgs _ () = ["."] argHelper _ _ _ = "." +instance Coalpit Scientific where + argParser _ = try $ do + x <- token (Right . unArg) Nothing + case reverse $ readP_to_S scientificP x of + (n, ""):_ -> pure n + _ -> fail $ "Failed to read a scientific number: " ++ x + toArgs opt n = [formatScientific + (scientificFormat opt) (scientificDecimals opt) n] + argHelper _ _ _ = "SCIENTIFIC" + + +pTime :: ParseTime a => Options -> String -> Parser a +pTime opt tf = try $ do + x <- token (Right . unArg) Nothing + case readSTime False (timeLocale opt) tf x of + [(t, "")] -> pure t + _ -> fail "Failed to parse time" + +timeArg :: FormatTime t => Options -> String -> t -> [String] +timeArg opt tf t = [formatTime (timeLocale opt) tf t] + +-- | Uses 'dateTimeFormat'. +instance Coalpit UTCTime where + argParser opt = pTime opt (dateTimeFormat opt) + toArgs opt = timeArg opt (dateTimeFormat opt) + argHelper _ _ _ = "UTC_TIME" + +-- | Uses 'dateTimeFormat'. +instance Coalpit ZonedTime where + argParser opt = pTime opt (dateTimeFormat opt) + toArgs opt = timeArg opt (dateTimeFormat opt) + argHelper _ _ _ = "ZONED_TIME" + +-- | Uses 'dateTimeFormat'. +instance Coalpit LocalTime where + argParser opt = pTime opt (dateTimeFormat opt) + toArgs opt = timeArg opt (dateTimeFormat opt) + argHelper _ _ _ = "LOCAL_TIME" + +-- | Uses 'dateTimeFormat'. +instance Coalpit UniversalTime where + argParser opt = pTime opt (dateTimeFormat opt) + toArgs opt = timeArg opt (dateTimeFormat opt) + argHelper _ _ _ = "UNIVERSAL_TIME" + +-- | Uses 'timeFormat'. +instance Coalpit TimeOfDay where + argParser opt = pTime opt (timeFormat opt) + toArgs opt = timeArg opt (timeFormat opt) + argHelper _ _ _ = "TIME_OF_DAY" + +-- | Uses 'dateFormat'. +instance Coalpit Day where + argParser opt = pTime opt (dateFormat opt) + toArgs opt = timeArg opt (dateFormat opt) + argHelper _ _ _ = "DAY" + +-- | Converts to/from 'Scientific'. +instance Coalpit NominalDiffTime where + argParser opt = fromRational . toRational + <$> (argParser opt :: Parser Scientific) + toArgs opt = toArgs opt . + (fromRational . toRational :: NominalDiffTime -> Scientific) + argHelper _ _ _ = "NOMINAL_DIFF_TIME" + +-- | Converts to/from 'Scientific'. +instance Coalpit DiffTime where + argParser opt = fromRational . toRational + <$> (argParser opt :: Parser Scientific) + toArgs opt = toArgs opt . + (fromRational . toRational :: DiffTime -> Scientific) + argHelper _ _ _ = "DIFF_TIME" + + instance Coalpit Bool instance Coalpit a => Coalpit (Maybe a) instance Coalpit a => Coalpit [a] +instance Coalpit a => Coalpit (NE.NonEmpty a) instance (Coalpit a, Coalpit b) => Coalpit (Either a b) instance (Coalpit a, Coalpit b) => Coalpit (a, b) instance (Coalpit a, Coalpit b, Coalpit c) => Coalpit (a, b, c) instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d) => Coalpit (a, b, c, d) -instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d, Coalpit e) => - Coalpit (a, b, c, d, e) diff --git a/coalpit.cabal b/coalpit.cabal index b093652..f8b9cd6 100644 --- a/coalpit.cabal +++ b/coalpit.cabal @@ -26,6 +26,8 @@ library exposed-modules: Coalpit build-depends: base >= 4.9 && < 5 , megaparsec >= 6.2 && < 7 + , scientific >= 0.3 && < 1 + , time >= 1.6 && < 2 default-language: Haskell2010 ghc-options: -Wall @@ -35,9 +37,9 @@ test-suite test-coalpit hs-source-dirs: test main-is: Test.hs build-depends: base >= 4.9 && < 5 + , coalpit , generic-random >= 1 && < 2 , tasty >= 0.12 && < 1 , tasty-quickcheck >= 0.9 && < 1 , tasty-travis >= 0.2 && < 1 - , coalpit ghc-options: -Wall -Wno-unused-top-binds diff --git a/test/Test.hs b/test/Test.hs index 9b92993..4d965c9 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -6,6 +6,8 @@ import Test.Tasty import Test.Tasty.QuickCheck as QC import Data.Proxy import Test.Tasty.Travis +import Data.Word +import Data.Int import Coalpit @@ -22,14 +24,14 @@ data Record = Record { maybeInt :: Maybe Int , maybeDouble :: Maybe Double , str :: String , listOfStrings :: [String] - , maybeListOfNumbers :: Maybe [Integer] + , maybeNonEmptyListOfNumbers :: Maybe [Integer] , otherString :: String } deriving (Generic, Eq, Show, Coalpit) instance Arbitrary Record where arbitrary = genericArbitraryU data Sum = Foo Int Bool | Bar - | Baz (String, (Double, Integer), Rational) + | Baz (Int8, (Float, Word16), Rational) deriving (Generic, Eq, Show, Coalpit) instance Arbitrary Sum where arbitrary = genericArbitraryU @@ -56,7 +58,7 @@ instance Arbitrary NestedRecord where arbitrary = genericArbitraryU data NestedSum = NestedFoo Record | NestedBar Sum Basic Nested - | NestedBaz (Polymorphic Int Double) + | NestedBaz (Polymorphic Char Double) deriving (Generic, Eq, Show, Coalpit) instance Arbitrary NestedSum where arbitrary = genericArbitraryU -- cgit v1.2.3