Commit for release 0.0.7.1

nstack-cli/app/NStackCLI.hs

@@ -92,12 +92,12 @@ formatNotebook module_name fn_name = DSLSource $
 
 run :: Command -> CCmd ()
 run (InitCommand initStack mBase gitRepo) = CLI.initCommand initStack mBase gitRepo
-run (StartCommand debug module_name fn_name) = callServer startCommand (formatNotebook module_name fn_name, debug) CLI.showStartMessage
-run (NotebookCommand debug mDsl) = do
+run (StartCommand debugOpt module_name fn_name) = callServer startCommand (formatNotebook module_name fn_name, debugOpt) CLI.showStartMessage
+run (NotebookCommand debugOpt mDsl) = do
   liftInput . HL.outputStrLn $ "NStack Notebook - import modules, write a workflow, and press " <> endStream <> " when finished to start it: "
   dsl <- maybe (liftIO $ DSLSource <$> TIO.getContents) pure mDsl
   liftInput . HL.outputStrLn $ "Building and running NStack Workflow. Please wait. This may take some time."
-  callServer startCommand (dsl, debug) CLI.showStartMessage
+  callServer startCommand (dsl, debugOpt) CLI.showStartMessage
   where endStream = if os == "mingw32" then "<Ctrl-Z>" else "<Ctrl-D>"
 run (StopCommand pId)         = callServer stopCommand pId CLI.showStopMessage
 run (LogsCommand pId)         = callServer logsCommand pId catLogs

nstack-cli/nstack-cli.cabal

@@ -1,5 +1,5 @@
 name: nstack-cli
-version: 0.0.7
+version: 0.0.7.1
 cabal-version: >=1.22
 build-type: Simple
 license: BSD3

nstack-prelude/nstack-prelude.cabal

@@ -1,5 +1,5 @@
 name: nstack-prelude
-version: 0.0.7
+version: 0.0.7.1
 cabal-version: >=1.22
 build-type: Simple
 license: BSD3

nstack-prelude/src/NStack/Prelude/Exception.hs

@@ -2,10 +2,12 @@ module NStack.Prelude.Exception
   ( TransientError(..)
   , PermanentError(..)
   , throwPermanentError
+  , throwPermanentErrorT
   )
   where
 
 import Control.Exception
+import Data.Text (unpack, Text)
 import Data.Typeable (Typeable)
 import Control.Monad.IO.Class (MonadIO(..))
 
@@ -24,3 +26,6 @@ instance Exception PermanentError where
 -- | A shortcut for commonly-occurring @liftIO . throwIO . PermanentError@.
 throwPermanentError :: MonadIO m => String -> m a
 throwPermanentError = liftIO . throwIO . PermanentError
+
+throwPermanentErrorT :: MonadIO m => Text -> m a
+throwPermanentErrorT = throwPermanentError . unpack

nstack/nstack.cabal

@@ -1,5 +1,5 @@
 name: nstack
-version: 0.0.7
+version: 0.0.7.1
 cabal-version: >=1.22
 build-type: Simple
 license: BSD3

nstack/src/NStack/Module/Types.hs

@@ -6,7 +6,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
 import Data.Coerce (coerce)
-import Data.SafeCopy (base, deriveSafeCopy, extension, Migrate(..))
+import Data.SafeCopy (base, deriveSafeCopy, extension, Migrate(..), SafeCopy(..), safePut, safeGet, contain)
 import Data.Semigroup
 import Data.Serialize (Serialize(..))
 import Data.Serialize.Get (getListOf)
@@ -161,6 +161,8 @@ instance Serialize FnName where
   put = coerce putText
   get = coerce getText
 
+$(deriveSafeCopy 0 'base ''FnName)
+
 -- | The name of an NStack type
 newtype TyName = TyName Text
   deriving (Eq, Ord, Typeable, Data, IsString, Pretty, Generic, ToJSON)
@@ -186,6 +188,10 @@ instance ToJSON a => ToJSON (Qualified a) where
 type QFnName = Qualified FnName
 type QTyName = Qualified TyName
 
+instance SafeCopy QFnName where
+  putCopy (Qualified mod' fn) = contain $ safePut mod' >> safePut fn
+  getCopy = contain $ Qualified <$> safeGet <*> safeGet
+
 instance Show a => Show (Qualified a) where
   show (Qualified modName methName) = pprS modName <> "." <> show methName
 

nstack/src/NStack/Settings.hs

@@ -18,6 +18,7 @@ module NStack.Settings (SettingsT,
                         frontendHost,
                         serviceLimits,
                         cliTimeout,
+                        debug,
                         defaultFrontendHost,
                         runSettingsParser,
                         serverConn,

nstack/src/NStack/Settings/Parser.hs

@@ -9,6 +9,7 @@ import qualified Data.UUID as UUID
 import Data.Yaml.Combinators
 
 import NStack.Auth (readUserId, readKey)
+import NStack.Module.Types (DebugOpt(..))
 import NStack.Settings.Types (AnalyticsSettings(..), HostName(..), ServerDetails(..), AuthSettings(..), Settings(..), InstallID(..))
 
 valueWhenMatching :: a -> Parser () -> Parser a
@@ -54,6 +55,12 @@ authSettingsParser = nstackAuthParser <> trustAuthParser
     secretKeyParser = validate string $
       maybe (Left "the secret-key to be a lowercase hexstring with even length") Right . readKey
 
+debugParser :: Parser DebugOpt
+debugParser = trueToDebug <$> bool
+  where
+    trueToDebug True = Debug
+    trueToDebug False = NoDebug
+
 settingsParser :: Parser Settings
 settingsParser = object $ Settings <$>
   optFieldOrNull "install-id" (InstallID <$> uuidParser) <*>
@@ -63,7 +70,8 @@ settingsParser = object $ Settings <$>
   optFieldOrNull "server" serverDetailsParser <*>
   optFieldOrNull "frontend-host" frontendHostParser <*>
   optFieldOrNull "service-limits" bool <*>
-  optFieldOrNull "cli-timeout" integer
+  optFieldOrNull "cli-timeout" integer <*>
+  optFieldOrNull "debug" debugParser
   where
     uuidParser = validate string $
       maybe (Left "install-id to be a valid UUID") Right . UUID.fromText

nstack/src/NStack/Settings/Types.hs

@@ -12,6 +12,7 @@ import Data.UUID (UUID)
 import Data.Text (Text, toLower)                -- from: text
 import GHC.Generics
 
+import NStack.Module.Types (DebugOpt(NoDebug))
 import NStack.Auth (SecretKey, UserId)
 
 newtype InstallID = InstallID UUID deriving (Eq, Show, ToJSON, FromJSON)
@@ -47,7 +48,8 @@ data Settings = Settings { _installId :: Maybe InstallID,
                            _server :: Maybe ServerDetails,
                            _frontendHost :: Maybe HostName,
                            _serviceLimits :: Maybe Bool,
-                           _cliTimeout :: Maybe Int
+                           _cliTimeout :: Maybe Int,
+                           _debug :: Maybe DebugOpt
                            }
   deriving (Eq, Show)
 
@@ -75,7 +77,7 @@ instance ToJSON AuthSettings where
                                "secret-key" .= key]
 
 defaultSettings :: Settings
-defaultSettings = Settings { _installId = Nothing, _analytics = Nothing, _authSettings = Nothing, _authServer = Nothing, _server = Nothing, _frontendHost = Nothing, _serviceLimits = Nothing, _cliTimeout = Nothing }
+defaultSettings = Settings { _installId = Nothing, _analytics = Nothing, _authSettings = Nothing, _authServer = Nothing, _server = Nothing, _frontendHost = Nothing, _serviceLimits = Nothing, _cliTimeout = Nothing, _debug = Nothing }
 
 installId :: Lens' Settings (Maybe InstallID)
 installId f s = (\r -> s { _installId = r }) <$> f (_installId s)
@@ -98,6 +100,9 @@ serviceLimits f s = (\r -> s { _serviceLimits = Just r }) <$> f (fromMaybe True
 cliTimeout :: Lens' Settings Int
 cliTimeout f s = (\r -> s { _cliTimeout = Just r }) <$> f (fromMaybe 15 $ _cliTimeout s)
 
+debug :: Lens' Settings DebugOpt
+debug f s = (\r -> s { _debug = Just r }) <$> f (fromMaybe NoDebug $ _debug s)
+
 authKey :: Lens' AuthSettings SecretKey
 authKey f = \case
   NStackHMAC u k -> NStackHMAC u <$> f k

nstack/test/TestSuite.hs

@@ -19,7 +19,7 @@ main = defaultMainWithIngredients (antXMLRunner:defaultIngredients) $ testGroup
 settingsParserTests :: TestTree
 settingsParserTests = testGroup "Unit Tests"
   [ testCase "Display a proper error message when invalid analytics settings" $
-      checkErrorMessages "test/res/invalid-analytics-settings.conf" "Expected \"enabled\", \"disabled\" instead of",
+      checkErrorMessages "test/res/invalid-analytics-settings.conf" "Expected \"disabled\", \"enabled\" instead of",
     testCase "Display a proper error message when invalid install-id" $
       checkErrorMessages "test/res/invalid-install-id.conf" "Expected install-id to be a valid UUID instead of",
     testCase "Display a proper error message when invalid server" $
@@ -29,7 +29,7 @@ settingsParserTests = testGroup "Unit Tests"
       checkErrorMessages "test/res/invalid-authentication1.conf" "Unexpected \n\nuser-id: abc123",
 
     testCase "Display a proper error message when more arguments for nstack scheme are needed" $
-      checkErrorMessages "test/res/invalid-authentication2.conf" "Expected \"trust\" instead of:",
+      checkErrorMessages "test/res/invalid-authentication2.conf" "Expected field \"user-id\" as part of:",
 
     testCase "Display a proper error message when invalid authentication scheme is used" $
       checkErrorMessages "test/res/invalid-authentication3.conf" "Expected \"nstack\", \"trust\" instead of:",
@@ -76,3 +76,4 @@ parseSettingsFileTest = do
         (Just (HostName "http://localhost:8000"))
         Nothing
         Nothing
+        Nothing

nstack/test_output.xml

@@ -1 +1 @@
-<?xml version='1.0' ?><testsuites errors="0" failures="0" tests="9" time="0.027"><testsuite name="Tests"><testsuite name="Unit Tests"><testcase name="Parse a settings file" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message if frontend-host contains a trailing slash" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid secret-key is used" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid authentication scheme is used" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when more arguments for nstack scheme are needed" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when trust scheme is given more arguments than needed" time="0.022" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid server" time="0.020" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid install-id" time="0.021" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid analytics settings" time="0.007" classname="Tests Unit Tests" /></testsuite></testsuite></testsuites>
+<?xml version='1.0' ?><testsuites errors="0" failures="0" tests="9" time="0.056"><testsuite name="Tests"><testsuite name="Unit Tests"><testcase name="Parse a settings file" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message if frontend-host contains a trailing slash" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid secret-key is used" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid authentication scheme is used" time="0.008" classname="Tests Unit Tests" /><testcase name="Display a proper error message when more arguments for nstack scheme are needed" time="0.000" classname="Tests Unit Tests" /><testcase name="Display a proper error message when trust scheme is given more arguments than needed" time="0.002" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid server" time="0.044" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid install-id" time="0.044" classname="Tests Unit Tests" /><testcase name="Display a proper error message when invalid analytics settings" time="0.000" classname="Tests Unit Tests" /></testsuite></testsuite></testsuites>

stack.yaml

@@ -16,10 +16,6 @@ packages:
     git: https://github.com/feuerbach/megaparsec.git
     commit: 3688649743914d4dbddcd8f30ea7be76bb25c249
   extra-dep: true
-- location:
-    git: https://github.com/feuerbach/yaml-combinators.git
-    commit: df2ca0cf92c24d6acd53ffa1f72509bd3aee585e
-  extra-dep: true
 extra-deps:
 - aeson-1.1.1.0
 - category-printf-0.1.1.0
@@ -31,6 +27,7 @@ extra-deps:
 - foundation-0.0.7
 # Dependency of the new megaparsec, not in stackage yet
 - parser-combinators-0.1.0
+- yaml-combinators-1.1
 # needed for yaml-combinators
 - generics-sop-0.3.1.0
 compiler: ghc-8.0.2