An example funflow pipeline to run a neuroimaging tool

funflow-neuro-example.hs

{-# LANGUAGE Arrows
, OverloadedStrings, QuasiQuotes, ScopedTypeVariables
, TemplateHaskell
#-}

import Control.Arrow   ((>>>), returnA, (&&&), (***)) 
import Control.Exception (Exception (..))
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text as T hiding (intercalate, head)
import System.Posix.Files
import Control.Funflow.External.Docker ()
import Control.Funflow.External
import Control.Funflow.ContentStore as CS
import Control.Funflow.ContentHashable as CH
import Control.Funflow
import Path
import Path.IO

-- An input file in the IO monad because parseAbsFile from
-- `Path` needs a MonadThrow.
input :: IO (Path Abs File)
input = parseAbsFile "/home/you/file.mnc"

-- Symlink an input file into the content store for tracking
-- this allows funflow to monitor the file hash without duplicating
-- my images which are large.
symlinkFileToStore :: ArrowFlow eff ex arr => arr (FileContent, Path Rel File) (CS.Content File)
symlinkFileToStore = putInStoreAt $
  \p (FileContent inFP) -> createSymbolicLink (toFilePath inFP) (toFilePath p)

-- Generate an output name from an input name by appending some suffixes before
-- the file extension. In IO again because of `Path`
appendBeforeExtension :: [String] -> String -> (Path b File) -> IO (Path b File)
appendBeforeExtension apps sep f = case apps of
  [] -> return f
  as -> do 
    fnox <- setFileExtension "" (filename f)
    fa <- parseRelFile $ toFilePath fnox ++ sep ++ intercalate sep as ++ fileExtension f
    return (parent f </> fa)    

-- Skeleton for how to build an external command from an input
mkIOCommand :: (ArrowFlow eff ex arr) =>
  Env ->
  OutputCapture ->
  Text ->
  (a -> IO ([Param], [Path Rel b])) ->
  arr a (Item, [Path Rel b])
mkIOCommand nv cap cmd munge = 
  (stepIO $ munge) >>> -- this step unpacks the IO, for path munging
  (external mkTask &&& step mkOuts)
  where
    mkTask (ins, _) =
      ExternalTask {_etCommand = cmd
                   , _etParams = ins
                   , _etEnv = nv
                   , _etWriteToStdOut = cap
                   }
    mkOuts = snd

-- The above specialized to use the parent environment vars and capture stdout
simpleIOCommand :: (ArrowFlow eff ex arr) =>
  Text ->
  (a -> IO ([Param], [Path Rel b])) ->
  arr a (Item, [Path Rel b])
simpleIOCommand = mkIOCommand EnvInherit StdOutCapture 

-- A simple pipeline that takes a file in the content store and makes a
-- new file in the content store by running an external command. This
-- takes an input image, adds three, and outputs the sum to the input
-- filename with _plus3 appended before the extension
mincMathP3 :: SimpleFlow (CS.Content File) (CS.Content File)
mincMathP3 = op >>> (step post)
  where
    mkParams i o =
      [contentParam i] ++ fmap stringParam ["-add", "-const", "3", toFilePath o]
    munge i = do
      o <- appendBeforeExtension ["plus3"] "_" (contentFilename i)
      return $ (mkParams i &&& (:[])) o
    op = simpleIOCommand "mincmath" munge
    post (it, nms) = head $ fmap (it :</>) nms

-- Main runs the pipeline, checking if the input image file (file.mnc)
-- has had its hashed changed since the last run, if it has it will add
-- three to each voxel in the image and ouput a new file in the content
-- store
main :: IO ()
main = do
    mnc <- input
    cwd <- getCurrentDir  
    r <- withSimpleLocalRunner (cwd </> [reldir|funflow-example/store|]) $ \run ->
      run (symlinkFileToStore >>> mincMathP3)
          (FileContent mnc, filename mnc)
    case r of 
      Left err ->
        putStrLn $ "FAILED: " ++ displayException err
      Right out ->
        putStrLn $ "SUCCESS: " ++ show out