summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-16 18:19:20 +0300
committerdefanor <defanor@uberspace.net>2017-12-16 18:19:20 +0300
commit6c55be7a476d04db91881bc8870d2a1e838ea521 (patch)
tree61925ec0eb007705565192399a92a6a2be19aa7a
parentb401482567a32a0c47f3f9d398268b70b0b0836f (diff)
Add more instances
-rw-r--r--Coalpit.hs28
-rw-r--r--coalpit.cabal1
-rw-r--r--test/Test.hs3
3 files changed, 30 insertions, 2 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 6e12651..b4b7b2f 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -85,6 +85,10 @@ import Data.Time.Calendar (Day)
import Data.Time.LocalTime (TimeOfDay, LocalTime, ZonedTime)
import Data.Scientific (Scientific, FPFormat(..), formatScientific, scientificP)
import Text.ParserCombinators.ReadP (readP_to_S)
+import Data.Complex (Complex)
+import Data.Version (Version, parseVersion, showVersion)
+import System.Exit (ExitCode)
+import Network.URI (URI, parseURIReference, uriToString)
import Coalpit.Parsing
@@ -107,13 +111,15 @@ data Options = Options { conNameMod :: String -> String
, dateTimeFormat :: String
, scientificFormat :: FPFormat
, scientificDecimals :: Maybe Int
+ , uriUserInfo :: String -> String
+ -- ^ Used to map the userinfo part of the URI.
}
-- | 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
+ (iso8601DateFormat (Just "%H:%M:%S")) Generic Nothing id
-- | Coalpit class: parsing, printing, usage strings.
class Coalpit a where
@@ -423,6 +429,23 @@ instance Coalpit Scientific where
(scientificFormat opt) (scientificDecimals opt) n]
argHelper _ _ _ = "SCIENTIFIC"
+instance Coalpit Version where
+ argParser _ = try $ do
+ x <- token (Right . unArg) Nothing
+ case reverse $ readP_to_S parseVersion x of
+ (v, ""):_ -> pure v
+ _ -> fail $ "Failed to read a version: " ++ x
+ toArgs _ v = [showVersion v]
+ argHelper _ _ _ = "VERSION"
+
+-- | An URI reference (absolute or relative).
+instance Coalpit URI where
+ argParser _ = try $ do
+ x <- token (Right . unArg) Nothing
+ maybe (fail $ "Failed to parse URI: " ++ x) pure (parseURIReference x)
+ toArgs opt u = [uriToString (uriUserInfo opt) u ""]
+ argHelper _ _ _ = "URI"
+
-- | Uses 'dateTimeFormat'.
instance Coalpit UTCTime where
@@ -478,6 +501,9 @@ instance Coalpit DiffTime where
instance Coalpit Bool
+instance Coalpit Ordering
+instance Coalpit ExitCode
+instance Coalpit a => Coalpit (Complex a)
instance Coalpit a => Coalpit (Maybe a)
instance Coalpit a => Coalpit [a]
instance Coalpit a => Coalpit (NE.NonEmpty a)
diff --git a/coalpit.cabal b/coalpit.cabal
index 6aedab0..38e8518 100644
--- a/coalpit.cabal
+++ b/coalpit.cabal
@@ -29,6 +29,7 @@ library
, megaparsec >= 6.2 && < 7
, scientific >= 0.3 && < 1
, time >= 1.6 && < 2
+ , network-uri >= 2.6 && < 3
default-language: Haskell2010
ghc-options: -Wall
diff --git a/test/Test.hs b/test/Test.hs
index 4d965c9..c1559fe 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -8,6 +8,7 @@ import Data.Proxy
import Test.Tasty.Travis
import Data.Word
import Data.Int
+import Data.Complex
import Coalpit
@@ -31,7 +32,7 @@ instance Arbitrary Record where arbitrary = genericArbitraryU
data Sum = Foo Int Bool
| Bar
- | Baz (Int8, (Float, Word16), Rational)
+ | Baz (Int8, (Complex Float, Word16), Rational)
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Sum where arbitrary = genericArbitraryU