summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Coalpit.hs130
-rw-r--r--Coalpit/Parsing.hs90
-rw-r--r--coalpit.cabal1
3 files changed, 115 insertions, 106 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 10228d6..6e12651 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -67,76 +67,26 @@ module Coalpit (
-- * Options
, Options(..)
, defOpt
- -- * Parsing and printing helpers
- , Parser
- , CLArg(..)
- , pS
- , readArg
- , pTime
- , timeArg
) where
-import Data.List
import GHC.Generics
import Text.Megaparsec
import Text.Megaparsec.Char
-import Data.Char
-import Data.Proxy
-import Data.Semigroup
-import Data.Void
+import Data.Char (toLower)
+import Data.Proxy (Proxy(..))
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 Data.Word (Word8, Word16, Word32, Word64)
+import Numeric.Natural (Natural)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Time.Clock (DiffTime, NominalDiffTime, UniversalTime, UTCTime)
+import Data.Time.Format ( TimeLocale, formatTime
+ , iso8601DateFormat, defaultTimeLocale)
+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)
-
--- | Command-line argument wrapper, used to avoid orphan ShowToken
--- String and Stream [String] instances.
-newtype CLArg = CLArg { unArg :: String }
- deriving (Ord, Eq)
-
--- | Advances by one token.
-advance :: Pos -> SourcePos -> t -> SourcePos
-advance _ (SourcePos n l c) _ = SourcePos n l (c <> pos1)
-
--- | A list of strings (command-line arguments) stream.
-instance Stream [CLArg] where
- type Token [CLArg] = CLArg
- type Tokens [CLArg] = [CLArg]
- tokenToChunk Proxy = pure
- tokensToChunk Proxy = id
- chunkToTokens Proxy = id
- chunkLength Proxy = length
- chunkEmpty Proxy = null
- advance1 Proxy = advance
- advanceN Proxy w = foldl' (advance w)
- take1_ [] = Nothing
- take1_ (t:ts) = Just (t, ts)
- takeN_ n s
- | n <= 0 = Just ([], s)
- | null s = Nothing
- | otherwise = Just (splitAt n s)
- takeWhile_ = span
-
-instance ShowToken CLArg where
- showTokens xs = concat $ NE.map unArg xs
-
--- | Command-line arguments parser.
-type Parser = Parsec Void [CLArg]
-
--- | Applies a String parser to a single argument.
-pS :: Parsec Void String a -> Parsec Void [CLArg] a
-pS p = try $ do
- x <- token (Right . unArg) Nothing
- case parse p "argument" x of
- Left e -> fail $ show e
- Right x' -> pure x'
+import Coalpit.Parsing
-- | Printing and parsing options.
@@ -377,14 +327,6 @@ instance (Coalpit a) => GCoalpit (K1 i a) where
-- Common types
--- | Reads an argument using its 'Read' instance.
-readArg :: Read a => Parser a
-readArg = do
- x <- token (Right . unArg) Nothing
- case reads x of
- [(n, "")] -> pure n
- _ -> fail $ "Failed to read: " ++ x
-
instance Coalpit Int where
argParser _ = readArg
toArgs _ i = [show i]
@@ -482,64 +424,40 @@ instance Coalpit Scientific where
argHelper _ _ _ = "SCIENTIFIC"
--- | Parses a time argument.
-pTime :: ParseTime a
- => Options
- -- ^ Options, to read 'timeLocale' from.
- -> String
- -- ^ Time format to use.
- -> 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"
-
--- | Composes a time argument.
-timeArg :: FormatTime t
- => Options
- -- ^ Options, to read 'timeLocale' from.
- -> String
- -- ^ Time format to use.
- -> t
- -- ^ Time value.
- -> [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)
+ argParser opt = pTime (timeLocale opt) (dateTimeFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
argHelper _ _ _ = "UTC_TIME"
-- | Uses 'dateTimeFormat'.
instance Coalpit ZonedTime where
- argParser opt = pTime opt (dateTimeFormat opt)
- toArgs opt = timeArg opt (dateTimeFormat opt)
+ argParser opt = pTime (timeLocale opt) (dateTimeFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
argHelper _ _ _ = "ZONED_TIME"
-- | Uses 'dateTimeFormat'.
instance Coalpit LocalTime where
- argParser opt = pTime opt (dateTimeFormat opt)
- toArgs opt = timeArg opt (dateTimeFormat opt)
+ argParser opt = pTime (timeLocale opt) (dateTimeFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
argHelper _ _ _ = "LOCAL_TIME"
-- | Uses 'dateTimeFormat'.
instance Coalpit UniversalTime where
- argParser opt = pTime opt (dateTimeFormat opt)
- toArgs opt = timeArg opt (dateTimeFormat opt)
+ argParser opt = pTime (timeLocale opt) (dateTimeFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
argHelper _ _ _ = "UNIVERSAL_TIME"
-- | Uses 'timeFormat'.
instance Coalpit TimeOfDay where
- argParser opt = pTime opt (timeFormat opt)
- toArgs opt = timeArg opt (timeFormat opt)
+ argParser opt = pTime (timeLocale opt) (timeFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (timeFormat opt) t]
argHelper _ _ _ = "TIME_OF_DAY"
-- | Uses 'dateFormat'.
instance Coalpit Day where
- argParser opt = pTime opt (dateFormat opt)
- toArgs opt = timeArg opt (dateFormat opt)
+ argParser opt = pTime (timeLocale opt) (dateFormat opt)
+ toArgs opt t = [formatTime (timeLocale opt) (dateFormat opt) t]
argHelper _ _ _ = "DAY"
-- | Converts to/from 'Scientific'.
diff --git a/Coalpit/Parsing.hs b/Coalpit/Parsing.hs
new file mode 100644
index 0000000..f8fe8fc
--- /dev/null
+++ b/Coalpit/Parsing.hs
@@ -0,0 +1,90 @@
+{- |
+Module : Coalpit.Parsing
+Description : Argument parsing facilities
+Maintainer : defanor <defanor@uberspace.net>
+Stability : unstable
+Portability : non-portable (uses GHC extensions)
+
+This module provides functions useful for argument parsing.
+-}
+
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Coalpit.Parsing ( Parser
+ , CLArg(..)
+ , pS
+ , readArg
+ , pTime
+ ) where
+
+import Text.Megaparsec
+import Data.Proxy (Proxy(..))
+import Data.Time.Format (TimeLocale, ParseTime, readSTime)
+import Data.Void (Void)
+import qualified Data.List.NonEmpty as NE
+import Data.List (foldl')
+import Data.Semigroup ((<>))
+
+-- | Command-line argument wrapper, used to avoid orphan ShowToken
+-- String and Stream [String] instances.
+newtype CLArg = CLArg { unArg :: String }
+ deriving (Ord, Eq)
+
+-- | Advances by one token.
+advance :: Pos -> SourcePos -> t -> SourcePos
+advance _ (SourcePos n l c) _ = SourcePos n l (c <> pos1)
+
+-- | A list of strings (command-line arguments) stream.
+instance Stream [CLArg] where
+ type Token [CLArg] = CLArg
+ type Tokens [CLArg] = [CLArg]
+ tokenToChunk Proxy = pure
+ tokensToChunk Proxy = id
+ chunkToTokens Proxy = id
+ chunkLength Proxy = length
+ chunkEmpty Proxy = null
+ advance1 Proxy = advance
+ advanceN Proxy w = foldl' (advance w)
+ take1_ [] = Nothing
+ take1_ (t:ts) = Just (t, ts)
+ takeN_ n s
+ | n <= 0 = Just ([], s)
+ | null s = Nothing
+ | otherwise = Just (splitAt n s)
+ takeWhile_ = span
+
+instance ShowToken CLArg where
+ showTokens xs = concat $ NE.map unArg xs
+
+-- | Command-line arguments parser.
+type Parser = Parsec Void [CLArg]
+
+-- | Applies a String parser to a single argument.
+pS :: Parsec Void String a -> Parsec Void [CLArg] a
+pS p = try $ do
+ x <- token (Right . unArg) Nothing
+ case parse p "argument" x of
+ Left e -> fail $ show e
+ Right x' -> pure x'
+
+-- | Reads an argument using its 'Read' instance.
+readArg :: Read a => Parser a
+readArg = do
+ x <- token (Right . unArg) Nothing
+ case reads x of
+ [(n, "")] -> pure n
+ _ -> fail $ "Failed to read: " ++ x
+
+-- | Parses a time argument.
+pTime :: ParseTime a
+ => TimeLocale
+ -- ^ Options, to read 'timeLocale' from.
+ -> String
+ -- ^ Time format to use.
+ -> Parser a
+pTime tl tf = try $ do
+ x <- token (Right . unArg) Nothing
+ case readSTime False tl tf x of
+ [(t, "")] -> pure t
+ _ -> fail "Failed to parse time"
diff --git a/coalpit.cabal b/coalpit.cabal
index f8b9cd6..6aedab0 100644
--- a/coalpit.cabal
+++ b/coalpit.cabal
@@ -24,6 +24,7 @@ source-repository head
library
exposed-modules: Coalpit
+ , Coalpit.Parsing
build-depends: base >= 4.9 && < 5
, megaparsec >= 6.2 && < 7
, scientific >= 0.3 && < 1