SciFlow 0.6.0 → 0.6.1

raw patch · 7 files changed

+35/−42 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• SciFlow.cabal +2/−2
• src/Scientific/Workflow/Internal/Builder.hs +6/−5
• src/Scientific/Workflow/Internal/Builder/Types.hs +1/−1
• src/Scientific/Workflow/Internal/DB.hs +20/−28
• src/Scientific/Workflow/Main.hs +4/−4
• src/Scientific/Workflow/Main/Options.hs +1/−1
• src/Scientific/Workflow/Visualize.hs +1/−1

@@ -1,5 +1,5 @@ name:                SciFlow-version:             0.6.0+version:             0.6.1 synopsis:            Scientific workflow management system description:         SciFlow is a DSL for building scientific workflows.                      Workflows built with SciFlow can be run either on desktop@@ -58,7 +58,7 @@     , lifted-async     , mtl     , network-    , optparse-applicative >=0.13.0.0+    , optparse-applicative >=0.14.0.0     , rainbow     , sqlite-simple     , split

@@ -162,8 +162,9 @@ -- | Add a prefix to IDs of nodes for a given builder, i.e., -- @id@ becomes @prefix_id@. namespace :: T.Text -> Builder () -> Builder ()-namespace prefix builder = builder >> addPrefix+namespace prefix builder = modify (st <>)   where+    st = execState (builder >> addPrefix) ([], [])     addPrefix = modify $ \(nodes, edges) ->         ( map (\x -> x{_nodePid = prefix <> "_" <> _nodePid x}) nodes         , map (\x -> x{ _edgeFrom = prefix <> "_" <> _edgeFrom x@@ -300,7 +301,7 @@         (Fail ex) -> liftIO (putMVar pSt pStValue) >> lift (throwE (pid, ex))         Success -> liftIO $ do             putMVar pSt pStValue-            readData pid $ wfState^.database+            fmap deserialize $ readData pid $ wfState^.database         Scheduled -> do             _ <- liftIO $ takeMVar $ wfState^.procParaControl @@ -324,7 +325,7 @@                         sendLog (wfState^.logServer) $ Warn pid "Failed!"                     lift (throwE (pid, ex))                 Right r -> liftIO $ do-                    saveData pid r $ wfState^.database+                    saveData pid (serialize r) $ wfState^.database                     putMVar pSt Success                     _ <- forkIO $ putMVar (wfState^.procParaControl) ()                     sendLog (wfState^.logServer) $ Complete pid@@ -351,7 +352,7 @@      -- Read data stored in this node     FetchData -> liftIO $ do-        r <- readData pid $ wfState^.database+        r <- fmap deserialize $ readData pid $ wfState^.database         B.putStr $ showYaml r         putMVar nodeSt $ Special Skip         return r@@ -361,7 +362,7 @@         c <- liftIO $ B.readFile inputData         r <- return (readYaml c) `asTypeOf` fn undefined         liftIO $ do-            updateData pid r $ wfState^.database+            updateData pid (serialize r) $ wfState^.database             putMVar nodeSt $ Special Skip             return r {-# INLINE handleSpecialMode #-}

@@ -73,7 +73,7 @@ deriveLift ''FunctionType deriveLift ''Attribute -makeLenses 'Attribute+makeLenses ''Attribute  defaultAttribute :: Attribute defaultAttribute = Attribute

@@ -1,13 +1,11 @@+{-# LANGUAGE ConstraintKinds      #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ConstraintKinds #-} module Scientific.Workflow.Internal.DB     ( openDB     , closeDB     , readData-    , readDataByteString-    , saveDataByteString     , saveData     , updateData     , delRecord@@ -30,8 +28,9 @@ import           Database.SQLite.Simple import           Text.Printf            (printf) --- | An abstract type representing the database used to store states of workflow-newtype WorkflowDB  = WorkflowDB Connection+--------------------------------------------------------------------------------+-- Data Serialization+--------------------------------------------------------------------------------  -- | @DBData@ constraint is used for data serialization. type DBData a = (FromJSON a, ToJSON a, S.Serialize a)@@ -51,8 +50,13 @@ readYaml :: DBData a => B.ByteString -> a readYaml = fromJust . decode -type PID = T.Text +-- | An abstract type representing the database used to store states of workflow+newtype WorkflowDB  = WorkflowDB Connection+type Key = T.Text+type Val = B.ByteString++ dbTableName :: String dbTableName = "SciFlowDB" @@ -82,48 +86,36 @@ closeDB (WorkflowDB db) = close db {-# INLINE closeDB #-} -readData :: DBData r => PID -> WorkflowDB -> IO r+readData :: Key -> WorkflowDB -> IO Val readData pid (WorkflowDB db) = do     [Only result] <- query db (Query $ T.pack $         printf "SELECT data FROM %s WHERE pid=?" dbTableName) [pid]-    return $ deserialize result-{-# INLINE readData #-}--readDataByteString :: PID -> WorkflowDB -> IO B.ByteString-readDataByteString pid (WorkflowDB db) = do-    [Only result] <- query db (Query $ T.pack $-        printf "SELECT data FROM %s WHERE pid=?" dbTableName) [pid]     return result-{-# INLINE readDataByteString #-}--saveData :: DBData r => PID -> r -> WorkflowDB -> IO ()-saveData pid result (WorkflowDB db) = execute db (Query $ T.pack $-    printf "INSERT INTO %s VALUES (?, ?)" dbTableName) (pid, serialize result)-{-# INLINE saveData #-}+{-# INLINE readData #-} -updateData :: DBData r => PID -> r -> WorkflowDB -> IO ()+updateData :: Key -> Val -> WorkflowDB -> IO () updateData pid result (WorkflowDB db) = execute db (Query $ T.pack $-    printf "UPDATE %s SET data=? WHERE pid=?" dbTableName) (serialize result, pid)+    printf "UPDATE %s SET data=? WHERE pid=?" dbTableName) (result, pid) {-# INLINE updateData #-} -saveDataByteString :: PID -> B.ByteString -> WorkflowDB -> IO ()-saveDataByteString pid result (WorkflowDB db) = execute db (Query $ T.pack $+saveData :: Key -> Val -> WorkflowDB -> IO ()+saveData pid result (WorkflowDB db) = execute db (Query $ T.pack $     printf "INSERT INTO %s VALUES (?, ?)" dbTableName) (pid, result)-{-# INLINE saveDataByteString #-}+{-# INLINE saveData #-} -isFinished :: PID -> WorkflowDB -> IO Bool+isFinished :: Key -> WorkflowDB -> IO Bool isFinished pid (WorkflowDB db) = do     result <- query db (Query $ T.pack $         printf "SELECT pid FROM %s WHERE pid = ?" dbTableName) [pid]     return $ not $ null (result :: [Only T.Text]) {-# INLINE isFinished #-} -getKeys :: WorkflowDB -> IO [PID]+getKeys :: WorkflowDB -> IO [Key] getKeys (WorkflowDB db) = concat <$> query_ db (Query $ T.pack $     printf "SELECT pid FROM %s;" dbTableName) {-# INLINE getKeys #-} -delRecord :: PID -> WorkflowDB -> IO ()+delRecord :: Key -> WorkflowDB -> IO () delRecord pid (WorkflowDB db) =     execute db (Query $ T.pack $ printf         "DELETE FROM %s WHERE pid = ?" dbTableName) [pid]

@@ -41,7 +41,7 @@ import           Data.Serialize                             (encode) import qualified Data.Text                                  as T import qualified Data.Text.Lazy.IO                          as T-import           Data.Yaml                                  (FromJSON, decode)+import           Data.Yaml                                  (FromJSON, decodeEither)  #ifdef DRMAA_ENABLED import           DRMAA                                      (withSession)@@ -218,10 +218,10 @@         config <- case configuration opts of             [] -> return def             fls -> do-                r <- decode . B.unlines <$> mapM B.readFile fls+                r <- decodeEither . B.unlines <$> mapM B.readFile fls                 case r of-                    Nothing -> error "fail to parse configuration file"-                    Just x  -> return x+                    Left err -> error err+                    Right x  -> return x          result <- runReaderT (runExceptT $ runReaderT (wf ()) initState) config         case result of

@@ -75,7 +75,7 @@   where     f x = case x of         ('\\' : '0' : rest) -> '\0' : rest-        x' -> x'+        x'                  -> x'  viewParser :: Parser CMD viewParser = View <$> switch (long "raw")

@@ -22,7 +22,7 @@     fmtnode (_, (i, attr)) = [G.Label $ G.HtmlLabel label]       where         label = H.Table $ H.HTable (Just []) tableAttr $ header : H.HorizontalRule :-            map toLine (wrap 45 $ attr^.note)+            map toLine (wrap 45 $ if T.null (attr^.note) then "Empty" else attr^.note)         header = H.Cells [H.LabelCell [] $ H.Text             [ H.Format H.Bold $ [H.Font [H.PointSize 18] [H.Str $ TL.fromStrict i]]             ]]