From b401482567a32a0c47f3f9d398268b70b0b0836f Mon Sep 17 00:00:00 2001 From: defanor Date: Sat, 16 Dec 2017 17:35:05 +0300 Subject: Move parsing helpers into Coalpit.Parsing --- Coalpit.hs | 130 ++++++++++------------------------------------------- Coalpit/Parsing.hs | 90 +++++++++++++++++++++++++++++++++++++ coalpit.cabal | 1 + 3 files changed, 115 insertions(+), 106 deletions(-) create mode 100644 Coalpit/Parsing.hs 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 +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 -- cgit v1.2.3