Commit for release 0.0.10.1

nstack-cli/app/NStackCLI.hs

@@ -44,7 +44,8 @@ import NStack.Comms.Types
 import NStack.Comms.ApiHashValue (apiHashValue)
 import NStack.Module.ConfigFile (ConfigFile(..), configFile, getConfigFile,
   workflowFile, projectFile, getProjectFile, _projectModules)
-import NStack.Module.Types (ModuleName, FnName, Qualified(..))
+import NStack.Module.Name (ModuleName)
+import NStack.Module.Types (FnName, Qualified(..))
 import NStack.Prelude.Text (pprT, prettyLinesOr, joinLines, showT)
 import NStack.Prelude.FilePath (fromFP)
 import NStack.Settings
@@ -88,6 +89,8 @@ formatNotebook module_name fn_name = DSLSource $
   "import " <> pprT module_name <> " as M" <> "\n" <>
   "M." <> pprT fn_name
 
+typeSignature :: MethodInfo -> TypeSignature
+typeSignature (MethodInfo ts _) = ts
 
 run :: Command -> CCmd ()
 run (InitCommand initStack gitRepo) = CLI.initCommand initStack gitRepo
@@ -103,15 +106,17 @@ run (StopCommand pId)                = callServer stopCommand pId CLI.showStopMe
 run (LogsCommand pId)                = callServer logsCommand pId catLogs
 run ServerLogsCommand                = callServer serverLogsCommand () catLogs
 run (InfoCommand fAll)               = callServer infoCommand fAll CLI.printInfo
-run (ListCommand mType fAll)         = callServer listCommand (mType, fAll) CLI.printMethods
+run (ListAllCommand fAll)            = callServer listAllCommand fAll (uncurry (<>) . bimap (CLI.printMethods . fmap typeSignature) CLI.printMethods)
+run (ListFnCommand mType fAll)       = callServer listFnCommand (fAll, Just mType) (CLI.printMethods . fmap typeSignature)
+run (ListTypesCommand fAll)          = callServer listTypesCommand fAll CLI.printMethods
 run (ListModulesCommand fAll)        = callServer listModulesCommand fAll (`prettyLinesOr` "No registered images")
 run (DeleteModuleCommand m)          = callServer deleteModuleCommand m (const $ "Module deleted: " <> pprT m)
 run ListProcessesCommand             = callServer listProcessesCommand () CLI.printProcesses
 run (ListStoppedCommand mStart mEnd) = callServer listStoppedCommand (mStart, mEnd) CLI.printProcesses
 run GarbageCollectCommand            = callServer gcCommand () (`prettyLinesOr` "Nothing removed")
 run ListScheduled                    = callServer listScheduledCommand () CLI.printScheduledProcesses
 run (ConnectCommand pId)             = connectStdInOut pId
-run (BuildCommand dropBadModules) =
+run (BuildCommand) =
   ifM (R.testfile projectFile) projectBuild
     (ifM (R.testfile configFile ||^ R.testfile workflowFile) workflowModule
       (throwError (unpack $ R.format ("A valid nstack build file ("%R.fp%", "%R.fp%", "%R.fp%") was not found") projectFile configFile workflowFile)))
@@ -121,10 +126,10 @@ run (BuildCommand dropBadModules) =
       modules <- _projectModules <$> getProjectFile
       forM_ modules $ \modPath -> do
         liftInput . HL.outputStrLn . unpack $ R.format ("Building " % R.fp) modPath
-        buildDirectory dropBadModules modPath
+        buildDirectory modPath
     workflowModule = do
       liftInput . HL.outputStrLn $ "Building an NStack module. Please wait. This may take some time."
-      buildDirectory dropBadModules "."
+      buildDirectory "."
 run (LoginCommand a b c d)    = CLI.loginSettings a b c d
 run (RegisterCommand userName email mServer) = CLI.registerCommand userName email mServer
 run (SendCommand path' snippet) = CLI.sendCommand path' snippet
@@ -149,8 +154,8 @@ randomPath = ("/" <>) . UUID.toText <$> randomIO
 
 -- | Build an nstack module (not a project) that resides in the given
 -- directory
-buildDirectory :: DropBadModules -> R.FilePath -> CCmd ()
-buildDirectory dropBadModules dir = do
+buildDirectory :: R.FilePath -> CCmd ()
+buildDirectory dir = do
   globs <- ifM (R.testfile (dir R.</> configFile))
     (do
       config <- liftIO $ getConfigFile dir
@@ -159,7 +164,7 @@ buildDirectory dropBadModules dir = do
     (return [])
 
   package <- CLI.buildArtefacts (fromFP dir) globs
-  callServer buildCommand (BuildTarball $ toStrict package, dropBadModules) showModuleBuild
+  callServer buildCommand (BuildTarball $ toStrict package) showModuleBuild
 
 -- | Run a command on the user client
 runClient :: Transport -> CCmd () -> IO ()

nstack-cli/data/client/templates/init/python/service.py

@@ -1,10 +1,10 @@
 #!/usr/bin/env python3
 """
-{{ name }} Service
+{{ name }} Module
 """
 import nstack
 
-class Service(nstack.BaseService):
+class Module(nstack.Module):
     def numChars(self, x):
         return len(x)
 

nstack-cli/data/client/templates/init/python2/service.py

@@ -4,7 +4,7 @@
 """
 import nstack
 
-class Service(nstack.BaseService):
+class Module(nstack.Module):
     def numChars(self, x):
         return len(x)
 

nstack-cli/data/client/templates/init/r/service.r

@@ -0,0 +1,8 @@
+#!/usr/bin/env Rscript
+# {{ name }} Service
+
+numChars <- function(s) {
+  nchar(s)
+}
+# this would also work:
+# numChars <- nchar

nstack-cli/nstack-cli.cabal

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

nstack-cli/src/NStack/CLI/Commands.hs

@@ -40,7 +40,6 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import qualified Data.Yaml as Y
-import Data.Coerce (coerce)
 import qualified Filesystem.Path.CurrentOS as FP -- system-filepath
 import Network.HTTP.Client hiding (responseStatus, Proxy)
 import Network.HTTP.Client.TLS (mkManagerSettings)
@@ -59,8 +58,11 @@ import NStack.CLI.Auth (allowSelfSigned)
 import NStack.CLI.Types
 import NStack.CLI.Templates (createFromTemplate)
 import NStack.Comms.Types
-import NStack.Module.Types
+import NStack.Module.Name (ModuleName, ModuleRef, ModuleURI(..), showShortModuleUri)
 import NStack.Module.Parser (parseModuleName)
+import NStack.Module.QMap (QMap(..))
+import NStack.Module.Types
+import NStack.Module.Version (ExactRelease(..), SemVer(..))
 import qualified NStack.Utils.Archive as Archive
 import NStack.Module.ConfigFile (configFile, workflowFile, ConfigStack(..), mkStackParent)
 import NStack.Prelude.Applicative ((<&>))
@@ -84,16 +86,18 @@ data Command
   | ConnectCommand ProcessId
   | ServerLogsCommand
   | InfoCommand Bool
-  | ListCommand (Maybe EntityType) Bool
+  | ListFnCommand MethodType Bool
+  | ListTypesCommand Bool
+  | ListAllCommand Bool
   | ListModulesCommand Bool
-  | DeleteModuleCommand ModuleName
+  | DeleteModuleCommand ModuleRef
   | ListProcessesCommand
   | ListStoppedCommand (Maybe StoppedFrom) (Maybe StoppedAmount)
   | GarbageCollectCommand
-  | BuildCommand DropBadModules
+  | BuildCommand
   | RegisterCommand UserName Email ServerAddr
   | SendCommand Path Snippet
-  | TestCommand ModuleName FnName Snippet
+  | TestCommand ModuleRef FnName Snippet
   | LoginCommand HostName Int UserId SecretKey
   | ListScheduled
 
@@ -110,8 +114,9 @@ instance M.ToMustache TemplateOut where
 snapshot :: (FedoraVersion, FedoraSnapshot)
 snapshot = (25, 0)
 
+-- The default api version for a language on `nstack init`
 langStacks :: Language -> APIVersion
-langStacks _ = 1
+langStacks _ = 2
 
 initCommand :: CCmdEff m => InitStack -> GitRepo -> m ()
 initCommand initStack (GitRepo wantGitRepo) = do
@@ -161,7 +166,7 @@ runTemplates curDir modName stackOrParent = do
 -- HACK - to remove once we have username on CLI / remove modulename parsing
 -- Currently used to display the ModuleName on the CLI without the default `nstack` author
 localModName :: ModuleName -> Text
-localModName = last . T.splitOn "nstack/" . T.pack . showShortModuleName
+localModName = last . T.splitOn "nstack/" . T.pack . showShortModuleUri
 
 
 -- | init the module using Git
@@ -173,51 +178,51 @@ initGitRepo = liftIO $ do
   -- Sh.run "git" ["branch", "nstack"]
 
 -- | Returns the artefacts needed to build a module
+-- | TODO: Needs to be updated to take the language from the nstack.yaml to determine the required files
 buildArtefacts
   :: CCmdEff m
   => FilePath -- ^ directory
   -> [FilePath] -- ^ globs from the files section of nstack.yaml
   -> m ByteString
 buildArtefacts dir globs = do
-  let std_files = [configFile, workflowFile, "setup.py", "service.py", "requirements.txt"]
+  let std_files = [configFile, workflowFile, "setup.py", "service.py", "requirements.txt", "service.r"]
   liftIO $ Archive.expandCheckPack dir std_files globs
 
 printInfo :: ServerInfo -> Text
 printInfo (ServerInfo ps stopped meths ms) = prettyT' $
       block "Running processes:" (map M.ppr ps) </>
       block "Stopped processes:" (map M.ppr stopped) </>
-      block "Available functions:" (prettyPrintMethods $ coerce . Map.toList . fmap typeSignature $ meths) </>
+      block "Available functions:" (prettyPrintMethods $ fmap typeSignature meths) </>
       M.text "Container modules:" </> showModules ms
         where
 
           typeSignature (MethodInfo t _) = t
 
-          showModules :: Map.Map ModuleName ModuleInfo -> M.Doc
+          showModules :: Map.Map ModuleRef ModuleInfo -> M.Doc
           showModules = M.stack . fmap M.text . renderTree . mkTree . Map.toList
 
-          renderTree :: Forest (ModuleName, ModuleInfo) -> [String]
+          renderTree :: Forest (ModuleRef, ModuleInfo) -> [String]
           renderTree = fmap (showTree . fmap renderMod)
             where
               renderMod (modName, ModuleInfo{..}) = unpack . prettyT 120 $
                 M.ppr modName M.<+> M.parens (M.commasep [maybe "Base" M.ppr _miStack,
                                                           if _miIsFramework then "Framework" else "User Code",
                                                           M.ppr _miImage])
 
-          mkTree :: [(ModuleName, ModuleInfo)] -> Forest (ModuleName, ModuleInfo)
+          mkTree :: [(ModuleRef, ModuleInfo)] -> Forest (ModuleRef, ModuleInfo)
           mkTree mods = unfoldForest f baseMods
             where baseMods = filter (isNothing . _miParent . snd) mods
                   f mod'@(modName, _) = (mod', filter ((== Just modName) . _miParent . snd) mods)
 
-printMethods :: [(Qualified Text, TypeSignature)] -> Text
+printMethods :: M.Pretty a => QMap a TypeSignature -> Text
 printMethods = prettyT' . M.stack . prettyPrintMethods
 
-prettyPrintMethods :: [(Qualified Text, TypeSignature)] -> [M.Doc]
-prettyPrintMethods =  moduleMethodBlocks . fmap (fmap printMethod) . fmap Map.toList . nest
+prettyPrintMethods :: M.Pretty a => QMap a TypeSignature -> [M.Doc]
+prettyPrintMethods =  moduleMethodBlocks . methodDocs
   where printMethod (uri, (TypeSignature ts)) = M.ppr uri <> " : " <> M.ppr ts
         printMethod (uri, TypeDefinition td) = "type " <> M.ppr uri <> " = " <> M.ppr td
+        methodDocs (QMap inner) = fmap (Map.foldMapWithKey (\k a -> [curry printMethod k a])) inner
         moduleMethodBlocks = fmap (uncurry (block . unpack . pprT)) . Map.toList
-        nest = foldr (\((Qualified c d), a) m -> Map.unionWith (<>) m (newMap c d a)) Map.empty
-        newMap c d a = Map.singleton c (Map.singleton d a)
 
 printProcesses :: forall a. ProcPrintable a => [ProcessInfo a] -> Text
 printProcesses = \case
@@ -260,8 +265,11 @@ showStartMessage (ProcessInfo (ProcessId pId) _ _ _) = "Successfully started as
 showStopMessage :: (ProcessInfo a) -> Text
 showStopMessage (ProcessInfo (ProcessId pId) _ _ _) = "Successfully stopped process " <> pId
 
-showModuleBuild :: ModuleName -> Text
-showModuleBuild mName = "Module " <> pprT mName <> " built successfully. Use `nstack list functions` to see all available functions."
+showModuleBuild :: ModuleRef -> Text
+showModuleBuild mName = "Module " <> T.pack (showShortModuleUri mName) <> " built successfully" <> maybeFullSnap <>  ". Use `nstack list functions` to see all available functions."
+  where maybeFullSnap = case release (version mName) of
+                          (Snap _) -> " (as " <> pprT mName  <> ")"
+                          _        -> ""
 
 loginSettings :: HostName -> Int -> UserId -> SecretKey -> CCmd ()
 loginSettings hostname port username pw = do modifySettings $ \s -> s & serverConn ?~ (ServerDetails (Just hostname)

nstack-cli/src/NStack/CLI/Parser.hs

@@ -12,8 +12,9 @@ import Text.Megaparsec (try)    -- from: megaparsec
 import NStack.Auth (hexUserId, textSecretKey, UserName(..), validEmail)
 import NStack.CLI.Commands (Command(..), InitStack(..))
 import NStack.Comms.Types
-import NStack.Module.Parser (pLanguage, inlineParser, parseModuleName)
-import NStack.Module.Types (DebugOpt(..), BaseImage(..), ModuleName(..), FnName(..))
+import NStack.Module.Parser (pLanguage, inlineParser, parseModuleName, parseModuleRef)
+import NStack.Module.Name (ModuleName, ModuleRef)
+import NStack.Module.Types (DebugOpt(..), BaseImage(..), FnName(..))
 import NStack.Prelude.Monad (maybeToRight)
 
 
@@ -24,6 +25,12 @@ pModuleName = argument pModuleName' (metavar "module" <> help "Module name")
     pModuleName' :: ReadM ModuleName
     pModuleName' = eitherReader (runExcept . parseModuleName . pack)
 
+pModuleRef :: Parser ModuleRef
+pModuleRef = argument pModuleRef' (metavar "module" <> help "Module reference")
+  where
+    pModuleRef' :: ReadM ModuleRef
+    pModuleRef' = eitherReader (runExcept . parseModuleRef . pack)
+
 pFnName :: Parser FnName
 pFnName = (FnName . pack) <$> strArgument (metavar "function_name" <> help "Function name")
 
@@ -107,20 +114,20 @@ sendOpts = SendCommand <$> argument str (metavar "path" <> help "Path the source
                        <*> argument str (metavar "event" <> help "JSON Snippet to send as an event")
 
 testOpts :: Parser Command
-testOpts = TestCommand <$> pModuleName
+testOpts = TestCommand <$> pModuleRef
                        <*> pFnName
                        <*> argument str (metavar "event" <> help "JSON Snippet to send as an event")
 
 
 listOpts :: Parser Command
 listOpts = hsubparser
   (  command "modules"   (info (pure ListModulesCommand) (progDesc "List all available modules"))
-  <> command "all"       (info (pure $ ListCommand Nothing) (progDesc "List all functions and types"))
-  <> command "sinks"     (info (pure $ ListCommand $ Just SinkType) (progDesc "List only sinks"))
-  <> command "sources"   (info (pure $ ListCommand $ Just SourceType) (progDesc "List only sources"))
-  <> command "functions" (info (pure $ ListCommand $ Just MethodType) (progDesc "List only unconnected functions"))
-  <> command "workflows" (info (pure $ ListCommand $ Just WorkflowType) (progDesc "List only fully-connected workflows"))
-  <> command "types" (info (pure $ ListCommand $ Just TypeType) (progDesc "List only types"))
+  <> command "all"       (info (pure ListAllCommand) (progDesc "List all functions and types"))
+  <> command "sinks"     (info (pure $ ListFnCommand SinkType) (progDesc "List only sinks"))
+  <> command "sources"   (info (pure $ ListFnCommand SourceType) (progDesc "List only sources"))
+  <> command "functions" (info (pure $ ListFnCommand MethodType) (progDesc "List only unconnected functions"))
+  <> command "workflows" (info (pure $ ListFnCommand WorkflowType) (progDesc "List only fully-connected workflows"))
+  <> command "types"     (info (pure ListTypesCommand) (progDesc "List only types"))
   ) <*> allSwitch
 
 loginOpts :: Parser Command
@@ -131,19 +138,14 @@ loginOpts = LoginCommand <$> argument (fromString <$> str) (metavar "SERVER_HOST
             where userId    = maybeReader $ (^? hexUserId) . fromString
                   secretKey = maybeReader $ (^? textSecretKey) . fromString
 
-buildOpts :: Parser Command
-buildOpts = BuildCommand
-  <$> flag FailBadModules DropBadModules
-        (long "force" <> short 'f' <> help "drop downstream modules that are broken by the new version of this module")
-
 -- | Parser for all subcommand options
 cmds :: Parser Command
 cmds =  hsubparser ( command "info" (info (InfoCommand <$> allSwitch) (progDesc "Show the server status"))
                 <>  command "init" (info initOpts (progDesc "Initialise a new module/workflow"))
                 <>  command "list" (info (helper <*> listOpts) (progDesc "List registered modules or functions"))
                 <>  command "list-scheduled" (info (pure ListScheduled) (progDesc "List scheduled processes"))
-                <>  command "build" (info buildOpts (progDesc "Build module"))
-                <>  command "delete" (info (DeleteModuleCommand <$> pModuleName) (progDesc "Delete a module"))
+                <>  command "build" (info (pure BuildCommand) (progDesc "Build module"))
+                <>  command "delete" (info (DeleteModuleCommand <$> pModuleRef) (progDesc "Delete a module"))
                 <>  command "start" (info startOpts (progDesc "Start a workflow"))
                 <>  command "notebook" (info notebookOpts (progDesc "Enter some DSL interactively"))
                 <>  command "stop" (info stopOpts (progDesc "Stop a process"))

nstack-prelude/nstack-prelude.cabal

@@ -1,5 +1,5 @@
 name: nstack-prelude
-version: 0.0.9
+version: 0.0.10.1
 cabal-version: >=1.22
 build-type: Simple
 license: BSD3
@@ -21,6 +21,7 @@ library
     NStack.Prelude.Exception
     NStack.Prelude.FilePath
     NStack.Prelude.Format
+    NStack.Prelude.Function
     NStack.Prelude.Parsec
     NStack.Prelude.Map
     NStack.Prelude.Monad

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

@@ -1,6 +1,7 @@
 module NStack.Prelude.FilePath (
+(</>)
   -- * File path conversions
-  toFP
+, toFP
 , fromFP
 , formatFP
 , fpToText
@@ -11,7 +12,7 @@ import Control.Monad.Except (MonadError)
 import Data.Bifunctor (first)
 import Data.Text (Text, unpack)
 import qualified Filesystem.Path.CurrentOS as FP
-import Turtle (format, fp)
+import Turtle (format, fp, (</>))
 
 import NStack.Prelude.Monad (eitherToExcept)
 

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

@@ -0,0 +1,24 @@
+module NStack.Prelude.Function where
+
+curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
+curry3 f a b c = f (a, b, c)
+
+curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
+curry4 f a b c d = f (a, b, c, d)
+
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+uncurry3 f (a, b, c) = f a b c
+
+uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
+uncurry4 f (a, b, c, d) = f a b c d
+
+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+(.:) f g a b = f (g a b)
+
+infixr 8 .:
+
+(.:.) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
+(.:.) f g a b c = f (g a b c)
+
+infixr 7 .:.
+