net-spider-cli 0.1.0.2 → 0.2.0.0

raw patch · 4 files changed

+155/−55 lines, 4 filesdep ~net-spiderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: net-spider

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• net-spider-cli.cabal +2/−2
• src/NetSpider/CLI/Snapshot.hs +105/−41
• test/NetSpider/CLI/SnapshotSpec.hs +38/−12

@@ -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`.

@@ -1,5 +1,5 @@ name:                   net-spider-cli-version:                0.1.0.2+version:                0.2.0.0 author:                 Toshio Ito <debug.ito@gmail.com> maintainer:             Toshio Ito <debug.ito@gmail.com> 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,

@@ -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"+                ]

@@ -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")