{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- | Aliases which behave similarly to their funflow 1.x counterparts.
module Funflow.Compat where

import Data.CAS.ContentHashable (ContentHashable)
import qualified Data.CAS.ContentStore as CS
import Data.Store (Store)
import Funflow (Flow, caching)
import Funflow.Flow (dockerFlow, getDirFlow, ioFlow, putDirFlow)
import Funflow.Tasks.Docker (DockerTaskConfig, DockerTaskInput)
import Path (Abs, Dir, Path)

stepIO :: (i -> IO o) -> Flow i o
stepIO :: (i -> IO o) -> Flow i o
stepIO = (i -> IO o) -> Rope r mantle core i o
forall i o. (i -> IO o) -> Flow i o
ioFlow

stepIO' :: (Show i, ContentHashable IO i, ContentHashable IO ident, Store o) => ident -> (i -> IO o) -> Flow i o
stepIO' :: ident -> (i -> IO o) -> Flow i o
stepIO' ident
ident = ident -> Rope r mantle core i o -> Rope r mantle core i o
forall (core :: * -> * -> *) ident a b (r :: RopeRec)
       (mantle :: [Strand]).
(Arrow core, ProvidesCaching core, ContentHashable IO ident,
 ContentHashable IO a, Store b) =>
ident -> Rope r mantle core a b -> Rope r mantle core a b
caching ident
ident (Rope r mantle core i o -> Rope r mantle core i o)
-> ((i -> IO o) -> Rope r mantle core i o)
-> (i -> IO o)
-> Rope r mantle core i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> IO o) -> Rope r mantle core i o
forall i o. (i -> IO o) -> Flow i o
ioFlow

docker :: DockerTaskConfig -> Flow DockerTaskInput CS.Item
docker :: DockerTaskConfig -> Flow DockerTaskInput Item
docker = DockerTaskConfig -> Rope r mantle core DockerTaskInput Item
DockerTaskConfig -> Flow DockerTaskInput Item
dockerFlow

putInStore :: Flow (Path Abs Dir) CS.Item
putInStore :: AnyRopeWith
  ('[] ++ RequiredStrands) (RequiredCore m) (Path Abs Dir) Item
putInStore = Rope r mantle core (Path Abs Dir) Item
Flow (Path Abs Dir) Item
putDirFlow

getFromStore :: Flow CS.Item (Path Abs Dir)
getFromStore :: AnyRopeWith
  ('[] ++ RequiredStrands) (RequiredCore m) Item (Path Abs Dir)
getFromStore = Rope r mantle core Item (Path Abs Dir)
Flow Item (Path Abs Dir)
getDirFlow