
Hello, I am writting a program which execute some scientific task via shake. liftIO $ shake shakeOptions{ shakeFiles=shakeFiles' , shakeReport=["/tmp/shake.html"] , shakeVerbosity=Diagnostic} $ do want [toFilePath uploaded] -- execute xdsme and deal with input dependencies toFilePath xml %> \_out -> do need (map toFilePath is) processXdsMe cwd' cell sg mr mo rdir images -- upload the result into the Databse toFilePath uploaded %> \_out -> actionXml xml b c uploaded processXdsMe :: Path Abs Dir -> Maybe Cell -> Maybe SpaceGroup -> Maybe Resolution -> Maybe Optimize -> Path Rel File -> String -> Action () processXdsMe cwd' mcell msg mr mo rdir images = cmd opts args where opts :: [CmdOption] opts = px1Opts ++ [Cwd . fromAbsDir $ cwd', AutoDeps] args = xdsMePath : catMaybes params params :: [Maybe String] params = [ Just "--brute" , Just "--weak" , Just "--xml" , Just ("-p" ++ fromRelFile rdir) , fmap (\(Cell a b c alpha beta gamma) -> printf "-c%f,%f,%f,%f,%f,%f" a b c alpha beta gamma) mcell , fmap (\sg -> "-s" ++ unpack sg) msg , fmap (\(Resolution r) -> printf "--resolution %f" r) mr , fmap (\o -> printf "--optimize %d" (fromEnum o)) mo , Just images ] actionXml :: Path Abs File -> Beamline -> SomeDataCollection -> Path Abs File -> Action () actionXml xml b c uploaded = do need [toFilePath xml] container <- liftIO . fromFile . toFilePath $ xml -- post processing let attachment = _autoProcProgramAttachment . _autoProcProgramContainer $ container attachment' <- liftIO $ runReaderT (toRuchePath attachment) b _ <- copyAttachment' attachment attachment' let container' = (autoProcProgramContainer . autoProcProgramAttachment .~ attachment') container -- replace attachement -- upload into ISPYB liftIO $ storeAutoProcIntoISPyB c NoAnomalous container' cmd_ ("touch" :: String) (toFilePath uploaded) My users want to change the arguments in the processXdsMe cmd args. How can I teach shake to rebuild a rules when the argument of the cmd change ? thanks for your help. Cheers

Hi,
How can I teach shake to rebuild a rules when the argument of the cmd change?
wrap the arguments that are subject to change into an oracle to detect changes and to re-run all actions that depend on the value: {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} import Development.Shake import Development.Shake.Classes newtype GetCmdlineArgs = GetCmdlineArgs () deriving (Show,Typeable,Eq,Hashable,Binary,NFData) type instance RuleResult GetCmdlineArgs = String main :: IO () main = shake shakeOptions $ do want ["foo.txt"] getCmdlineArgs <- addOracle $ \(GetCmdlineArgs ()) -> return "This is a test!" "*.txt" %> \out -> do args <- getCmdlineArgs (GetCmdlineArgs ()) command [FileStdout out] "echo" [args] Best regards, Peter
participants (2)
-
Peter Simons
-
PICCA Frederic-Emmanuel