SciFlow 0.1.0 → 0.2.0

raw patch · 4 files changed

+203/−33 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• SciFlow.cabal +60/−10
• src/Scientific/Workflow/Builder.hs +52/−12
• src/Scientific/Workflow/Builder/TH.hs +34/−11
• src/Scientific/Workflow/Types.hs +57/−0

@@ -2,17 +2,67 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                SciFlow-version:             0.1.0+version:             0.2.0 synopsis:            Scientific workflow management system-description:         SciFlow is to help programmers design complex workflows-                     with ease.-                     .-                     Feature includes: -                     .-                        1. Use "labeled" arrows to connect individual steps-                           and cache computational results.-                        2. Use monad and template haskell to automate the process-                           of building DAGs.+description:+  SciFlow is to help programmers design complex workflows+  with ease.+  .+  Feature includes: +  .+  1. Use "labeled" arrows to connect individual steps+  and cache computational results.+  .+  2. Use monad and template haskell to automate the process+  of building DAGs.+  .+  Here is a trivial example. Since we use template haskell,+  we need to divide this small program into two files.+  .+  > -- File 1: MyModule.hs+  >+  > module MyModule where+  >+  > import Control.Arrow+  > import Scientific.Workflow+  >+  > input :: Actor () Int+  > input = arr $ const 10+  > +  > plus1 :: Actor Int Int+  > plus1 = arr (+1)+  >+  > mul2 :: Actor Int Int+  > mul2 = arr (*2)+  >+  > combine :: Actor (Int, Int) Int+  > combine = arr $ \(a,b) -> a + b+  >+  > -- builder monad+  > builder :: Builder ()+  > builder = do+  > node "id000" "input" "this is input"+  > node "id001" "plus1" "add 1 to the input"+  > node "id002" "mul2" "double the input"+  > node "id003" "combine" "combine two input"+  >+  > "id000" ~> "id001"+  > "id000" ~> "id002"+  > link2 ("id001", "id002") "id003"+  >+  > --------------------------------------------+  > -- File 2: main.hs+  >+  > import Scientific.Workflow+  > import MyModule+  > import Data.Default+  >+  > -- assemble workflow using template haskell+  > $(mkWorkflow "myWorkflow" builder)+  >+  > main = do result <- runWorkflow myWorkflow def+  >           print result+  .  license:             MIT license-file:        LICENSE

@@ -1,41 +1,78 @@+{-# LANGUAGE FlexibleInstances #-} module Scientific.Workflow.Builder where  import Control.Arrow (second)-import Control.Monad.State.Lazy (State, modify)+import Control.Monad.State.Lazy (State, modify, foldM_) import qualified Data.HashMap.Strict as M import qualified Data.Text as T import Data.Tuple (swap) -data Unit = S String-          | L String String-          | L2 (String,String) String-          | L3 (String,String,String) String+data Factor = S String+            | L String String+            | L2 (String,String) String+            | L3 (String,String,String) String+            | L4 (String,String,String,String) String+            | L5 (String,String,String,String,String) String+            | L6 (String,String,String,String,String,String) String  data B = B     { _nodes :: [(String, String, T.Text)]-    , _links :: [(String, Unit)]+    , _links :: [(String, Factor)]     }  type Builder = State B +-- | Declare a computational node node :: String -> String -> T.Text -> Builder () node l f anno = modify $ \s -> s{_nodes = (l,f,anno) : _nodes s} +-- | many-to-one generalized link function+link :: [String] -> String -> Builder ()+link [] t = singleton t+link [a] t = link1 a t+link [a,b] t = link2 (a,b) t+link [a,b,c] t = link3 (a,b,c) t+link [a,b,c,d] t = link4 (a,b,c,d) t+link [a,b,c,d,e] t = link5 (a,b,c,d,e) t+link [a,b,c,d,e,f] t = link6 (a,b,c,d,e,f) t+link _ _ = error "I can't have so many links, yet!"++-- | (~>) = link.+(~>) :: [String] -> String -> Builder ()+(~>) = link++-- | singleton singleton :: String -> Builder () singleton t = modify $ \s -> s{_links = (t, S t) : _links s} -link :: String -> String -> Builder ()-link a t = modify $ \s -> s{_links = (t, L a t) : _links s}+-- | Declare a path. +path :: [String] -> Builder ()+path ns = foldM_ f (head ns) $ tail ns+  where+    f a t = link1 a t >> return t -(~>) :: String -> String -> Builder ()-(~>) = link+-- | one-to-one link+link1 :: String -> String -> Builder ()+link1 a t = modify $ \s -> s{_links = (t, L a t) : _links s} +-- | two-to-one link link2 :: (String, String) -> String -> Builder () link2 (a,b) t = modify $ \s -> s{_links = (t, L2 (a,b) t) : _links s} +-- | tree-to-one link link3 :: (String, String, String) -> String -> Builder () link3 (a,b,c) t = modify $ \s -> s{_links = (t, L3 (a,b,c) t) : _links s} +link4 :: (String, String, String, String) -> String -> Builder ()+link4 (a,b,c,d) t = modify $ \s -> s{_links = (t, L4 (a,b,c,d) t) : _links s}++link5 :: (String, String, String, String, String) -> String -> Builder ()+link5 (a,b,c,d,e) t = modify $ \s -> s{_links = (t, L5 (a,b,c,d,e) t) : _links s}++link6 :: (String, String, String, String, String, String) -> String -> Builder ()+link6 (a,b,c,d,e,f) t = modify $ \s -> s{_links = (t, L6 (a,b,c,d,e,f) t) : _links s}++ data Graph = Graph     { _children :: M.HashMap String [String]     , _parents :: M.HashMap String [String]@@ -51,8 +88,8 @@ leaves :: Graph -> [String] leaves g = filter (\x -> null $ children x g) $ _vertice g -fromUnits :: [Unit] -> Graph-fromUnits us = Graph cs ps vs'+fromFactors :: [Factor] -> Graph+fromFactors us = Graph cs ps vs'   where     cs = M.fromListWith (++) $ map (second return) es'     ps = M.fromListWith (++) $ map (second return . swap) es'@@ -63,3 +100,6 @@     f (L a t) = ([a,t], [(a,t)])     f (L2 (a,b) t) = ([a,b,t], [(a,t),(b,t)])     f (L3 (a,b,c) t) = ([a,b,c,t], [(a,t),(b,t),(c,t)])+    f (L4 (a,b,c,d) t) = ([a,b,c,d,t], [(a,t),(b,t),(c,t),(d,t)])+    f (L5 (a,b,c,d,e) t) = ([a,b,c,d,e,t], [(a,t),(b,t),(c,t),(d,t),(e,t)])+    f (L6 (a,b,c,d,e,f) t) = ([a,b,c,d,e,f,t], [(a,t),(b,t),(c,t),(d,t),(e,t),(f,t)])

@@ -18,7 +18,7 @@     return $ nodeDec ++ wfDec   where     builder = execState st $ B [] []-    endNodes = map (\x -> M.lookupDefault undefined x m) . leaves . fromUnits . snd . unzip . _links $ builder+    endNodes = map (\x -> M.lookupDefault undefined x m) . leaves . fromFactors . snd . unzip . _links $ builder     m = M.fromList $ _links builder     nd = map (\(a,b,_) -> (a,b)) $ _nodes builder @@ -29,17 +29,40 @@     f (l, ar) = [d| $(varP $ mkName l) = proc l $(varE $ mkName ar) |] {-# INLINE declareNodes #-} -linkNodes :: Unit -> M.HashMap String Unit -> Q Exp+linkNodes :: Factor -> M.HashMap String Factor -> Q Exp linkNodes nd m = [| Workflow $(go nd) |]   where     lookup' x = M.lookupDefault (S x) x m-    go (S a)          = varE $ mkName a-    go (L a t)        = [| $(go $ lookup' a) >>> $(go $ S t) |]-    go (L2 (a,b) t)   = [| zipS  $(go $ lookup' a) -                                 $(go $ lookup' b)-                             >>> $(go $ S t) |]-    go (L3 (a,b,c) t) = [| zipS3 $(go $ lookup' a)-                                 $(go $ lookup' b)-                                 $(go $ lookup' c)-                             >>> $(go $ S t) |]+    go (S a) = varE $ mkName a+    go (L a t) = [| $(go $ lookup' a) >>> $(go $ S t) |]+    go (L2 (a,b) t) =+        [| zipS  $(go $ lookup' a) +                 $(go $ lookup' b)+             >>> $(go $ S t) |]+    go (L3 (a,b,c) t) =+        [| zipS3 $(go $ lookup' a)+                 $(go $ lookup' b)+                 $(go $ lookup' c)+             >>> $(go $ S t) |]+    go (L4 (a,b,c,d) t) =+        [| zipS4 $(go $ lookup' a)+                 $(go $ lookup' b)+                 $(go $ lookup' c)+                 $(go $ lookup' d)+             >>> $(go $ S t) |]+    go (L5 (a,b,c,d,f) t) =+        [| zipS5 $(go $ lookup' a)+                 $(go $ lookup' b)+                 $(go $ lookup' c)+                 $(go $ lookup' d)+                 $(go $ lookup' f)+             >>> $(go $ S t) |]+    go (L6 (a,b,c,d,f,e) t) =+        [| zipS6 $(go $ lookup' a)+                 $(go $ lookup' b)+                 $(go $ lookup' c)+                 $(go $ lookup' d)+                 $(go $ lookup' f)+                 $(go $ lookup' e)+             >>> $(go $ S t) |] {-# INLINE linkNodes #-}

@@ -91,6 +91,63 @@     c <- h ()     return (a,b,c) +zipS4 :: Source a+      -> Source b+      -> Source c+      -> Source d+      -> Source (a,b,c,d)+zipS4 (Processor f)+      (Processor g)+      (Processor h)+      (Processor i)+      = Processor $ \_ -> do+          a <- f ()+          b <- g ()+          c <- h ()+          d <- i ()+          return (a,b,c,d)++zipS5 :: Source a+      -> Source b+      -> Source c+      -> Source d+      -> Source e+      -> Source (a,b,c,d,e)+zipS5 (Processor f)+      (Processor g)+      (Processor h)+      (Processor i)+      (Processor j)+      = Processor $ \_ -> do+          a <- f ()+          b <- g ()+          c <- h ()+          d <- i ()+          e <- j ()+          return (a,b,c,d,e)++zipS6 :: Source a+      -> Source b+      -> Source c+      -> Source d+      -> Source e+      -> Source f+      -> Source (a,b,c,d,e,f)+zipS6 (Processor f)+      (Processor g)+      (Processor h)+      (Processor i)+      (Processor j)+      (Processor k)+      = Processor $ \_ -> do+          a <- f ()+          b <- g ()+          c <- h ()+          d <- i ()+          e <- j ()+          f <- k ()+          return (a,b,c,d,e,f)+ data Config = Config     { _baseDir :: !FilePath     }