diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Revision history for net-spider-cli +## 0.2.0.0 -- 2019-10-13 + +* Add `--duration` option to `parserSnapshotQuery` function. +* [BREAKING CHANGE] `parserSnapshotQuery` function now returns a new type `CLISnapshotQuery`. + This is because some combinations of `--time-from`, `--time-to` and `--duration` options + are invalid. To express that case, users have to use `makeSnapshotQuery` function to get + a `Query` object, and that function can fail. +* [BREAKING CHANGE] Remove `basisSnapshotQuery` field from `SnapshotConfig`. + `makeSnapshotQuery` function now plays the same role. + ## 0.1.0.2 -- 2019-10-04 * Confirm test with `hashable-1.3.0.0`. diff --git a/net-spider-cli.cabal b/net-spider-cli.cabal --- a/net-spider-cli.cabal +++ b/net-spider-cli.cabal @@ -1,5 +1,5 @@ name: net-spider-cli -version: 0.1.0.2 +version: 0.2.0.0 author: Toshio Ito maintainer: Toshio Ito license: BSD3 @@ -24,7 +24,7 @@ NetSpider.CLI.Snapshot -- other-modules: build-depends: base >=4.11.1.0 && <4.13, - net-spider >=0.3.2.0 && <0.4, + net-spider >=0.3.3.0 && <0.4, optparse-applicative >=0.14.3.0 && <0.16, aeson >=1.2.4 && <1.5, hashable >=1.2.6.1 && <1.4, diff --git a/src/NetSpider/CLI/Snapshot.hs b/src/NetSpider/CLI/Snapshot.hs --- a/src/NetSpider/CLI/Snapshot.hs +++ b/src/NetSpider/CLI/Snapshot.hs @@ -7,22 +7,29 @@ -- graphs. module NetSpider.CLI.Snapshot ( parserSnapshotQuery, - SnapshotConfig(..) + makeSnapshotQuery, + SnapshotConfig(..), + CLISnapshotQuery ) where -import Control.Applicative ((<$>), (<*>), many) +import Control.Applicative ((<$>), (<*>), (<|>), many, optional, empty) +import Data.Int (Int64) +import NetSpider.Interval + ( interval, parseTimeIntervalEnd, secSince, secUntil, + IntervalEnd, Interval + ) import qualified NetSpider.Query as Q +import NetSpider.Timestamp (Timestamp) import qualified Options.Applicative as Opt -import NetSpider.Interval (interval, parseTimeIntervalEnd) +import qualified Options.Applicative.Types as OptT -- | Configuration for option parser for Snapshot 'Q.Query'. -data SnapshotConfig n na fla sla = +-- +-- @since 0.2.0.0 +data SnapshotConfig n = SnapshotConfig { nodeIDReader :: Opt.ReadM n, -- ^ Parser that reads a CLI option to generate a node ID. - basisSnapshotQuery :: Q.Query n na fla sla, - -- ^ Basis for queries for snapshot graphs. Fields in this basis - -- are overwritten by CLI options. startsFromAsArguments :: Bool -- ^ If 'True', the 'Q.startsFrom' field is read from CLI -- arguments. If 'False', arguments are not parsed. In either @@ -30,14 +37,60 @@ -- 'Q.startsFrom'. } --- | CLI option parser for 'Q.Query'. -parserSnapshotQuery :: SnapshotConfig n na fla sla - -> Opt.Parser (Q.Query n na fla sla) -parserSnapshotQuery conf = fmap fromParsedElement the_parser +-- | Settings for Snapshot 'Q.Query' parsed from the command-line +-- options. You can make 'Q.Query' by 'makeSnapshotQuery' function. +-- +-- @since 0.2.0.0 +data CLISnapshotQuery n = + CLISnapshotQuery + { startsFrom :: [n], + timeDurationSec :: Maybe Int64, + timeFrom :: Maybe (IntervalEnd Timestamp), + timeTo :: Maybe (IntervalEnd Timestamp) + } + deriving (Show,Eq,Ord) + +-- | Make a 'Q.Query' by applying 'CLISnapshotQuery' to the base +-- query. The 'CLISnapshotQuery' overwrites 'Q.startsFrom' and +-- 'Q.timeInterval' fields. +-- +-- It can fail to convert 'CLISnapshotQuery' to 'Q.Query' fields. In +-- that case, the result is 'Left' with a human-readable error +-- message. +-- +-- @since 0.2.0.0 +makeSnapshotQuery :: Q.Query n na fla sla -- ^ base query + -> CLISnapshotQuery n + -> Either String (Q.Query n na fla sla) + -- ^ Left: human-readable error message. Right: updated query +makeSnapshotQuery q cliq = do + ivl <- makeTimeInterval cliq + return $ q { Q.startsFrom = startsFrom cliq, + Q.timeInterval = ivl + } + +makeTimeInterval :: CLISnapshotQuery n -> Either String (Interval Timestamp) +makeTimeInterval c = + case (timeFrom c, timeTo c, timeDurationSec c) of + (ms, me, Nothing) -> Right $ interval s e + where + s = maybe (Q.NegInf, False) id ms + e = maybe (Q.PosInf, False) id me + (Just s, Nothing, Just d) -> Right $ secSince d s + (Nothing, Just e, Just d) -> Right $ secUntil d e + (Just _, Just _, Just _) -> Left ("Specifying all --time-to, --time-from and --duration is not allowed.") + (Nothing, Nothing, Just _) -> Left ("Specifying --duration only is not allowed. Specify --time-to or --time-from, too.") + +-- | CLI option parser for Snapshot 'Q.Query'. Use 'makeSnapshotQuery' +-- to convert 'CLISnapshotQuery' to 'Q.Query'. +-- +-- @since 0.2.0.0 +parserSnapshotQuery :: SnapshotConfig n + -> Opt.Parser (CLISnapshotQuery n) +parserSnapshotQuery conf = + CLISnapshotQuery <$> pStartsFromTotal <*> pDuration <*> pTimeLower <*> pTimeUpper where - basis = basisSnapshotQuery conf - fromParsedElement (sf, ti) = basis { Q.startsFrom = sf, Q.timeInterval = ti } - the_parser = (,) <$> ((++) <$> pStartsFrom <*> pStartsFromArgs) <*> pTimeInterval + pStartsFromTotal = (++) <$> pStartsFrom <*> pStartsFromArgs rNodeID = nodeIDReader conf nodeID_metavar = "NODE-ID" pStartsFrom = many $ Opt.option rNodeID $ mconcat @@ -52,30 +105,41 @@ [ Opt.help $ "Same as -s option.", Opt.metavar $ nodeID_metavar ] - pTimeInterval = interval <$> pTimeLower <*> pTimeUpper - pTimeLower = Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat - [ Opt.short 'f', - Opt.long "time-from", - Opt.help ( "Lower bound of query timestamp. " - ++ "Local findings with timestamp newer than this value are used to create the snapshot graph. " - ++ "ISO 8601 format is used for timestamps (e.g. `2019-03-22T10:20:12+09:00`). " - ++ "The timezone is optional. " - ++ "By default, the lower bound is inclusive. " - ++ "Add prefix 'x' to make it exclusive (e.g. `x2019-03-22T10:20:12+09:00`). " - ++ "Prefix of 'i' explicitly mark the lower bound is inclusive. " - ++ "Special value `x-inf` indicates there is no lower bound. " - ++ "Default: x-inf"), - Opt.metavar "TIMESTAMP", - Opt.value (Q.NegInf, False) - ] - pTimeUpper = Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat - [ Opt.short 't', - Opt.long "time-to", - Opt.help ( "Upper bound of query timestamp. " - ++ "Local findings with timestamp older than this value are used to create the snapshot graph. " - ++ "See --time-from for format of timestamps. " - ++ "Special value `x+inf` indicates there is no upper bound. " - ++ "Default: x+inf"), - Opt.metavar "TIMESTAMP", - Opt.value (Q.PosInf, False) - ] + pTimeLower = + optional $ Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat + ( [ Opt.short 'f', + Opt.long "time-from", + Opt.help ( "Lower bound of query timestamp. " + ++ "Local findings with timestamp newer than this value are used to create the snapshot graph. " + ++ "ISO 8601 format is used for timestamps (e.g. `2019-03-22T10:20:12+09:00`). " + ++ "The timezone is optional. " + ++ "By default, the lower bound is inclusive. " + ++ "Add prefix 'x' to make it exclusive (e.g. `x2019-03-22T10:20:12+09:00`). " + ++ "Prefix of 'i' explicitly mark the lower bound is inclusive. " + ++ "Special value `x-inf` indicates there is no lower bound. " + ++ "Default: x-inf" + ), + Opt.metavar "TIMESTAMP" + ] + ) + pTimeUpper = + optional $ Opt.option (Opt.eitherReader parseTimeIntervalEnd) $ mconcat + ( [ Opt.short 't', + Opt.long "time-to", + Opt.help ( "Upper bound of query timestamp. " + ++ "Local findings with timestamp older than this value are used to create the snapshot graph. " + ++ "See --time-from for format of timestamps. " + ++ "Special value `x+inf` indicates there is no upper bound. " + ++ "Default: x+inf" + ), + Opt.metavar "TIMESTAMP" + ] + ) + pDuration = optional $ Opt.option Opt.auto $ mconcat + [ Opt.short 'd', + Opt.long "duration", + Opt.help ( "Duration of the query time interval in seconds. " + ++ " Use with either --time-to or --time-from option." + ), + Opt.metavar "SECONDS" + ] diff --git a/test/NetSpider/CLI/SnapshotSpec.hs b/test/NetSpider/CLI/SnapshotSpec.hs --- a/test/NetSpider/CLI/SnapshotSpec.hs +++ b/test/NetSpider/CLI/SnapshotSpec.hs @@ -1,68 +1,94 @@ module NetSpider.CLI.SnapshotSpec (main,spec) where +import Data.List (isInfixOf) import NetSpider.Interval (interval, Extended(..)) import NetSpider.Query ( startsFrom, defQuery, timeInterval, - foundNodePolicy, policyAppend + foundNodePolicy, policyAppend, + Query ) import NetSpider.Timestamp (fromEpochMillisecond) import qualified Options.Applicative as Opt import Test.Hspec import NetSpider.CLI.TestCommon (runP) -import NetSpider.CLI.Snapshot (SnapshotConfig(..), parserSnapshotQuery) +import NetSpider.CLI.Snapshot (SnapshotConfig(..), parserSnapshotQuery, makeSnapshotQuery) -defConfig :: SnapshotConfig Int () () () +defConfig :: SnapshotConfig Int defConfig = SnapshotConfig { nodeIDReader = Opt.auto, - basisSnapshotQuery = (defQuery []) { foundNodePolicy = policyAppend }, startsFromAsArguments = False } main :: IO () main = hspec spec +parseSQ :: SnapshotConfig Int -> [String] -> Either String (Query Int () () ()) +parseSQ sconf args = makeSnapshotQuery base_query =<< runP (parserSnapshotQuery sconf) args + where + base_query = (defQuery []) { foundNodePolicy = policyAppend } + spec :: Spec spec = describe "parserSnapshotQuery" $ do specify "default" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) [] + let (Right got) = parseSQ defConfig [] startsFrom got `shouldBe` [] timeInterval got `shouldBe` interval (NegInf, False) (PosInf, False) foundNodePolicy got `shouldBe` policyAppend specify "time-from" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) + let (Right got) = parseSQ defConfig ["--time-from", "2019-02-19T11:12:00"] timeInterval got `shouldBe` interval (Finite $ fromEpochMillisecond 1550574720000, True) (PosInf, False) specify "time-to with exclusive" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) + let (Right got) = parseSQ defConfig ["--time-to", "x2017-12-20T19:22:02"] timeInterval got `shouldBe` interval (NegInf, False) (Finite $ fromEpochMillisecond 1513797722000, False) specify "both time-from and time-to with inclusive" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) + let (Right got) = parseSQ defConfig ["-f", "i2018-10-11T14:13:33", "-t", "i2018-10-11T14:13:50.332"] timeInterval got `shouldBe` interval (Finite $ fromEpochMillisecond 1539267213000, True) (Finite $ fromEpochMillisecond 1539267230332, True) specify "explicit infinity" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) + let (Right got) = parseSQ defConfig ["--time-from", "-inf", "--time-to", "+inf"] timeInterval got `shouldBe` interval (NegInf, True) (PosInf, True) specify "multiple starts-from" $ do - let (Right got) = runP (parserSnapshotQuery defConfig) + let (Right got) = parseSQ defConfig ["-s", "10", "-s", "12", "-s", "15"] startsFrom got `shouldBe` [10,12,15] let argsConfig = defConfig { startsFromAsArguments = True } specify "startsFromAsArguments" $ do - let (Right got) = runP (parserSnapshotQuery argsConfig) + let (Right got) = parseSQ argsConfig ["143", "200", "473","21"] startsFrom got `shouldBe` [143, 200, 473, 21] specify "startsFromAsArguments - -s still enabled" $ do - let (Right got) = runP (parserSnapshotQuery argsConfig) + let (Right got) = parseSQ argsConfig ["90", "-s", "181"] startsFrom got `shouldBe` [181, 90] + specify "duration + time-from" $ do + let (Right got) = parseSQ defConfig + ["--duration", "3600", "--time-from", "i2019-04-30T19:03:33"] + timeInterval got `shouldBe` + interval (Finite $ fromEpochMillisecond 1556651013000, True) + (Finite $ fromEpochMillisecond (1556651013000 + 3600000), False) + specify "duration + time-to" $ do + let (Right got) = parseSQ defConfig + ["-d", "600", "--time-to", "x2019-04-30T19:03:33"] + timeInterval got `shouldBe` + interval (Finite $ fromEpochMillisecond (1556651013000 - 600000), True) + (Finite $ fromEpochMillisecond 1556651013000, False) + specify "duration + time-to + time-from expects error" $ do + let (Left err) = parseSQ defConfig + ["-d", "600", "--time-to", "x2019-04-30T19:03:33", "--time-from", "x2019-04-30T17:00:52"] + err `shouldSatisfy` (isInfixOf "all --time-to, --time-from and --duration is not allowed") + specify "duration without time-to or time-from" $ do + let (Left err) = parseSQ defConfig + ["-d", "600"] + err `shouldSatisfy` (isInfixOf "--duration only is not allowed")