module Proteome.Tags.Gen where

import Conc (Lock, lockOrSkip_)
import qualified Data.List as List
import Data.Sequence ((|>))
import qualified Data.Text as Text (intercalate, replace)
import Exon (exon)
import GHC.IO.Exception (ExitCode (..))
import qualified Log
import Log (Severity (Warn))
import Path (File, Path, Rel, addExtension, toFilePath, (</>))
import Path.IO (doesFileExist, removeFile, renameFile)
import Polysemy.Process (SysProcConf, SystemProcess, SystemProcessScopeError, interpretSystemProcessNativeSingle)
import qualified Polysemy.Process.SystemProcess as Process
import Ribosome (
  Handler,
  LogReport,
  Report (Report),
  Reports,
  SettingError,
  Settings,
  mapReport,
  reportStop,
  resumeReport,
  )
import Ribosome.Report (storeReport)
import qualified Ribosome.Settings as Settings
import System.Process.Typed (proc, setWorkingDir)

import Proteome.Data.Env (Env)
import qualified Proteome.Data.Env as Env (mainProject, projects)
import Proteome.Data.Project (Project (Project), langOrType)
import Proteome.Data.ProjectLang (ProjectLang (unProjectLang))
import Proteome.Data.ProjectMetadata (ProjectMetadata (DirProject))
import Proteome.Data.ProjectRoot (ProjectRoot (ProjectRoot))
import qualified Proteome.Data.TagsError as TagsError
import Proteome.Data.TagsError (TagsError)
import qualified Proteome.Settings as Settings

data TagsLock =
  TagsLock
  deriving stock (TagsLock -> TagsLock -> Bool
(TagsLock -> TagsLock -> Bool)
-> (TagsLock -> TagsLock -> Bool) -> Eq TagsLock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsLock -> TagsLock -> Bool
$c/= :: TagsLock -> TagsLock -> Bool
== :: TagsLock -> TagsLock -> Bool
$c== :: TagsLock -> TagsLock -> Bool
Eq, Int -> TagsLock -> ShowS
[TagsLock] -> ShowS
TagsLock -> FilePath
(Int -> TagsLock -> ShowS)
-> (TagsLock -> FilePath) -> ([TagsLock] -> ShowS) -> Show TagsLock
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TagsLock] -> ShowS
$cshowList :: [TagsLock] -> ShowS
show :: TagsLock -> FilePath
$cshow :: TagsLock -> FilePath
showsPrec :: Int -> TagsLock -> ShowS
$cshowsPrec :: Int -> TagsLock -> ShowS
Show)

replaceFormatItem :: Text -> (Text, Text) -> Text
replaceFormatItem :: Text -> (Text, Text) -> Text
replaceFormatItem Text
original (Text
placeholder, Text
replacement) =
  Text -> Text -> Text -> Text
Text.replace (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
placeholder Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") Text
replacement Text
original

formatTagsArgs ::
  [ProjectLang] ->
  ProjectRoot ->
  Path Rel File ->
  Text ->
  Text
formatTagsArgs :: [ProjectLang] -> ProjectRoot -> Path Rel File -> Text -> Text
formatTagsArgs [ProjectLang]
langs (ProjectRoot Path Abs Dir
root) Path Rel File
fileName Text
formatString =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' @[] Text -> (Text, Text) -> Text
replaceFormatItem Text
formatString [(Text, Text)]
formats
  where
    formats :: [(Text, Text)]
formats = [
      (Text
"langsComma", Text -> [Text] -> Text
Text.intercalate Text
"," ((ProjectLang -> Text) -> [ProjectLang] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProjectLang -> Text
unProjectLang [ProjectLang]
langs)),
      (Text
"tagFile", FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (Path Abs File -> FilePath) -> Path Abs File -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs File -> Text) -> Path Abs File -> Text
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fileName),
      (Text
"root", FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir -> Text) -> Path Abs Dir -> Text
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
root)
      ]

tempname ::
  Member (Stop TagsError) r =>
  Path Rel File ->
  Sem r (Path Rel File)
tempname :: forall (r :: EffectRow).
Member (Stop TagsError) r =>
Path Rel File -> Sem r (Path Rel File)
tempname Path Rel File
name =
  (SomeException -> TagsError)
-> Either SomeException (Path Rel File) -> Sem r (Path Rel File)
forall err' (r :: EffectRow) err a.
Member (Stop err') r =>
(err -> err') -> Either err a -> Sem r a
stopEitherWith (TagsError -> SomeException -> TagsError
forall a b. a -> b -> a
const TagsError
err) (FilePath -> Path Rel File -> Either SomeException (Path Rel File)
forall (m :: * -> *) b.
MonadThrow m =>
FilePath -> Path b File -> m (Path b File)
addExtension FilePath
".tmp" Path Rel File
name)
  where
    err :: TagsError
err =
      TagsError
TagsError.TempName

deleteTempTags ::
  Members [Settings !! SettingError, Stop TagsError, Embed IO] r =>
  ProjectRoot ->
  Sem r ()
deleteTempTags :: forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Embed IO] r =>
ProjectRoot -> Sem r ()
deleteTempTags (ProjectRoot Path Abs Dir
root) = do
  Path Rel File
name <- (SettingError -> TagsError)
-> Sem (Settings : r) (Path Rel File) -> Sem r (Path Rel File)
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist SettingError -> TagsError
TagsError.Setting (Setting (Path Rel File) -> Sem (Settings : r) (Path Rel File)
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting (Path Rel File)
Settings.tagsFileName)
  Path Abs File
path <- (Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel File -> Path Abs File)
-> Sem r (Path Rel File) -> Sem r (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Rel File -> Sem r (Path Rel File)
forall (r :: EffectRow).
Member (Stop TagsError) r =>
Path Rel File -> Sem r (Path Rel File)
tempname Path Rel File
name
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs File -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
path) do
    IO () -> Sem r ()
forall (r :: EffectRow). Member (Embed IO) r => IO () -> Sem r ()
tryAny_ (Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile Path Abs File
path)

replaceTags ::
  Members [Settings !! SettingError, Stop TagsError, Embed IO] r =>
  ProjectRoot ->
  Sem r ()
replaceTags :: forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Embed IO] r =>
ProjectRoot -> Sem r ()
replaceTags (ProjectRoot Path Abs Dir
root) = do
  Path Rel File
name <- (SettingError -> TagsError)
-> Sem (Settings : r) (Path Rel File) -> Sem r (Path Rel File)
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist SettingError -> TagsError
TagsError.Setting (Setting (Path Rel File) -> Sem (Settings : r) (Path Rel File)
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting (Path Rel File)
Settings.tagsFileName)
  Path Abs File
temppath <- (Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel File -> Path Abs File)
-> Sem r (Path Rel File) -> Sem r (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Rel File -> Sem r (Path Rel File)
forall (r :: EffectRow).
Member (Stop TagsError) r =>
Path Rel File -> Sem r (Path Rel File)
tempname Path Rel File
name
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs File -> Sem r Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
temppath) do
    (Text -> TagsError) -> IO () -> Sem r ()
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryIOError Text -> TagsError
TagsError.RenameTags (Path Abs File -> Path Abs File -> IO ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
renameFile Path Abs File
temppath (Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
name))

notifyError ::
  Member Reports r =>
  [Text] ->
  Sem r ()
notifyError :: forall (r :: EffectRow). Member Reports r => [Text] -> Sem r ()
notifyError [Text]
out =
  ReportContext -> Report -> Sem r ()
forall (r :: EffectRow).
Member Reports r =>
ReportContext -> Report -> Sem r ()
storeReport ReportContext
"tags" (HasCallStack => Text -> [Text] -> Severity -> Report
Text -> [Text] -> Severity -> Report
Report Text
"tag generation failed" (Text
"tag subprocess failed: " Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
out) Severity
Warn)

tagsCommand ::
  Members [Settings, Stop TagsError] r =>
  ProjectRoot ->
  [ProjectLang] ->
  Sem r (Text, Text)
tagsCommand :: forall (r :: EffectRow).
Members '[Settings, Stop TagsError] r =>
ProjectRoot -> [ProjectLang] -> Sem r (Text, Text)
tagsCommand ProjectRoot
root [ProjectLang]
langs = do
  Text
cmd <- Setting Text -> Sem r Text
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Text
Settings.tagsCommand
  Text
args <- Setting Text -> Sem r Text
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Text
Settings.tagsArgs
  Path Rel File
fileName <- Setting (Path Rel File) -> Sem r (Path Rel File)
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting (Path Rel File)
Settings.tagsFileName
  Path Rel File
tmp <- Path Rel File -> Sem r (Path Rel File)
forall (r :: EffectRow).
Member (Stop TagsError) r =>
Path Rel File -> Sem r (Path Rel File)
tempname Path Rel File
fileName
  pure (Text
cmd, [ProjectLang] -> ProjectRoot -> Path Rel File -> Text -> Text
formatTagsArgs [ProjectLang]
langs ProjectRoot
root Path Rel File
tmp Text
args)

tagsProcess ::
  Members [Settings !! SettingError, Stop TagsError, Log] r =>
  ProjectRoot ->
  [ProjectLang] ->
  Sem r SysProcConf
tagsProcess :: forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Log] r =>
ProjectRoot -> [ProjectLang] -> Sem r SysProcConf
tagsProcess projectRoot :: ProjectRoot
projectRoot@(ProjectRoot Path Abs Dir
root) [ProjectLang]
langs = do
  (Text
cmd, Text
args) <- (SettingError -> TagsError)
-> Sem (Settings : r) (Text, Text) -> Sem r (Text, Text)
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist SettingError -> TagsError
TagsError.Setting (ProjectRoot -> [ProjectLang] -> Sem (Settings : r) (Text, Text)
forall (r :: EffectRow).
Members '[Settings, Stop TagsError] r =>
ProjectRoot -> [ProjectLang] -> Sem r (Text, Text)
tagsCommand ProjectRoot
projectRoot [ProjectLang]
langs)
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|executing tags: `#{cmd} #{args}` in directory #{show root}|]
  pure (FilePath -> SysProcConf -> SysProcConf
forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
root) (FilePath -> [FilePath] -> SysProcConf
proc (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
cmd) (FilePath -> [FilePath]
List.words (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
args))))

readStderr ::
  Member (SystemProcess !! err) r =>
  Sem r [Text]
readStderr :: forall err (r :: EffectRow).
Member (SystemProcess !! err) r =>
Sem r [Text]
readStderr =
  Seq Text -> Sem r [Text]
forall {err} {r :: EffectRow} {a}.
(Member (Resumable err SystemProcess) r,
 ConvertUtf8 a ByteString) =>
Seq a -> Sem r [a]
spin Seq Text
forall a. Monoid a => a
mempty
  where
    spin :: Seq a -> Sem r [a]
spin Seq a
buf =
      Sem (SystemProcess : r) ByteString -> Sem r (Either err ByteString)
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> Sem r (Either err a)
resumeEither Sem (SystemProcess : r) ByteString
forall (r :: EffectRow). Member SystemProcess r => Sem r ByteString
Process.readStderr Sem r (Either err ByteString)
-> (Either err ByteString -> Sem r [a]) -> Sem r [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right ByteString
l -> Seq a -> Sem r [a]
spin (Seq a
buf Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> ByteString -> a
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
l)
        Left err
_ -> [a] -> Sem r [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
buf)

executeTags ::
  Members [Settings !! SettingError, Reports, Stop TagsError, Log, Resource, Embed IO] r =>
  ProjectRoot ->
  [ProjectLang] ->
  Sem r ()
executeTags :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Reports, Stop TagsError, Log, Resource,
    Embed IO]
  r =>
ProjectRoot -> [ProjectLang] -> Sem r ()
executeTags ProjectRoot
projectRoot [ProjectLang]
langs = do
  ProjectRoot -> Sem r ()
forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Embed IO] r =>
ProjectRoot -> Sem r ()
deleteTempTags ProjectRoot
projectRoot
  SysProcConf
procConf <- ProjectRoot -> [ProjectLang] -> Sem r SysProcConf
forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Log] r =>
ProjectRoot -> [ProjectLang] -> Sem r SysProcConf
tagsProcess ProjectRoot
projectRoot [ProjectLang]
langs
  forall e e' (r :: EffectRow) a.
Member (Stop e') r =>
(e -> e') -> Sem (Stop e : r) a -> Sem r a
mapStop @SystemProcessScopeError (Text -> TagsError
TagsError.Process (Text -> TagsError)
-> (SystemProcessScopeError -> Text)
-> SystemProcessScopeError
-> TagsError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemProcessScopeError -> Text
forall b a. (Show a, IsString b) => a -> b
show) (Sem (Stop SystemProcessScopeError : r) () -> Sem r ())
-> Sem (Stop SystemProcessScopeError : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ SysProcConf
-> InterpreterFor
     (SystemProcess !! SystemProcessError)
     (Stop SystemProcessScopeError : r)
forall (r :: EffectRow).
Members '[Stop SystemProcessScopeError, Resource, Embed IO] r =>
SysProcConf
-> InterpreterFor (SystemProcess !! SystemProcessError) r
interpretSystemProcessNativeSingle SysProcConf
procConf do
    (SystemProcessError -> TagsError)
-> Sem
     (SystemProcess
        : (SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ExitCode
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ExitCode
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Text -> TagsError
TagsError.Process (Text -> TagsError)
-> (SystemProcessError -> Text) -> SystemProcessError -> TagsError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemProcessError -> Text
forall b a. (Show a, IsString b) => a -> b
show) Sem
  (SystemProcess
     : (SystemProcess !! SystemProcessError)
     : Stop SystemProcessScopeError : r)
  ExitCode
forall (r :: EffectRow). Member SystemProcess r => Sem r ExitCode
Process.wait Sem
  ((SystemProcess !! SystemProcessError)
     : Stop SystemProcessScopeError : r)
  ExitCode
-> (ExitCode
    -> Sem
         ((SystemProcess !! SystemProcessError)
            : Stop SystemProcessScopeError : r)
         ())
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ExitCode
ExitSuccess -> do
        Text
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug Text
"success"
        ProjectRoot
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (r :: EffectRow).
Members '[Settings !! SettingError, Stop TagsError, Embed IO] r =>
ProjectRoot -> Sem r ()
replaceTags ProjectRoot
projectRoot
      ExitFailure Int
_ -> do
        Text
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug Text
"failure"
        [Text]
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (r :: EffectRow). Member Reports r => [Text] -> Sem r ()
notifyError ([Text]
 -> Sem
      ((SystemProcess !! SystemProcessError)
         : Stop SystemProcessScopeError : r)
      ())
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     [Text]
-> Sem
     ((SystemProcess !! SystemProcessError)
        : Stop SystemProcessScopeError : r)
     ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem
  ((SystemProcess !! SystemProcessError)
     : Stop SystemProcessScopeError : r)
  [Text]
forall err (r :: EffectRow).
Member (SystemProcess !! err) r =>
Sem r [Text]
readStderr

projectTags ::
  Members [Settings !! SettingError, Settings, Reports, Stop TagsError, Log, Resource, Embed IO] r =>
  Project ->
  Sem r ()
projectTags :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Settings, Reports, Stop TagsError, Log,
    Resource, Embed IO]
  r =>
Project -> Sem r ()
projectTags (Project (DirProject ProjectName
_ ProjectRoot
root Maybe ProjectType
tpe) [ProjectType]
_ Maybe ProjectLang
lang [ProjectLang]
langs) =
  ProjectRoot -> [ProjectLang] -> Sem r ()
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Reports, Stop TagsError, Log, Resource,
    Embed IO]
  r =>
ProjectRoot -> [ProjectLang] -> Sem r ()
executeTags ProjectRoot
root (Maybe ProjectLang -> [ProjectLang]
forall a. Maybe a -> [a]
maybeToList (Maybe ProjectLang -> Maybe ProjectType -> Maybe ProjectLang
langOrType Maybe ProjectLang
lang Maybe ProjectType
tpe) [ProjectLang] -> [ProjectLang] -> [ProjectLang]
forall a. Semigroup a => a -> a -> a
<> [ProjectLang]
langs)
projectTags Project
_ =
  Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit

execution ::
  Members [Settings !! SettingError, DataLog LogReport, Async, Stop Report] r =>
  Bool ->
  Sem (Stop TagsError : r) () ->
  Sem r ()
execution :: forall (r :: EffectRow).
Members
  '[Settings !! SettingError, DataLog LogReport, Async, Stop Report]
  r =>
Bool -> Sem (Stop TagsError : r) () -> Sem r ()
execution = \case
  Bool
True ->
    Sem r (Async (Maybe ())) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Async (Maybe ())) -> Sem r ())
-> (Sem (Stop TagsError : r) () -> Sem r (Async (Maybe ())))
-> Sem (Stop TagsError : r) ()
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r () -> Sem r (Async (Maybe ()))
forall (r :: EffectRow) a.
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
async (Sem r () -> Sem r (Async (Maybe ())))
-> (Sem (Stop TagsError : r) () -> Sem r ())
-> Sem (Stop TagsError : r) ()
-> Sem r (Async (Maybe ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Stop TagsError : r) () -> Sem r ()
forall err (r :: EffectRow).
(Reportable err, Member (DataLog LogReport) r) =>
Sem (Stop err : r) () -> Sem r ()
reportStop
  Bool
False ->
    Sem (Stop TagsError : r) () -> Sem r ()
forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport

proGenTags ::
  Members [AtomicState Env, Settings !! SettingError, DataLog LogReport, Lock @@ TagsLock, Reports] r =>
  Members [Log, Resource, Async, Embed IO] r =>
  Handler r ()
proGenTags :: forall (r :: EffectRow).
(Members
   '[AtomicState Env, Settings !! SettingError, DataLog LogReport,
     Lock @@ TagsLock, Reports]
   r,
 Members '[Log, Resource, Async, Embed IO] r) =>
Handler r ()
proGenTags =
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Settings (Sem (Settings : Stop Report : r) () -> Sem (Stop Report : r) ())
-> Sem (Settings : Stop Report : r) () -> Sem (Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Settings : Stop Report : r) Bool
-> Sem (Settings : Stop Report : r) ()
-> Sem (Settings : Stop Report : r) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Setting Bool -> Sem (Settings : Stop Report : r) Bool
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Bool
Settings.tagsEnable) do
    Project
main <- (Env -> Project) -> Sem (Settings : Stop Report : r) Project
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> Project
Env.mainProject
    [Project]
extra <- (Env -> [Project]) -> Sem (Settings : Stop Report : r) [Project]
forall s s' (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s') -> Sem r s'
atomicGets Env -> [Project]
Env.projects
    Bool
fork <- Setting Bool -> Sem (Settings : Stop Report : r) Bool
forall a (r :: EffectRow).
(MsgpackDecode a, Member Settings r) =>
Setting a -> Sem r a
Settings.get Setting Bool
Settings.tagsFork
    Bool
-> Sem (Stop TagsError : Settings : Stop Report : r) ()
-> Sem (Settings : Stop Report : r) ()
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, DataLog LogReport, Async, Stop Report]
  r =>
Bool -> Sem (Stop TagsError : r) () -> Sem r ()
execution Bool
fork (Sem (Stop TagsError : Settings : Stop Report : r) ()
 -> Sem (Settings : Stop Report : r) ())
-> Sem (Stop TagsError : Settings : Stop Report : r) ()
-> Sem (Settings : Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
-> Sem (Stop TagsError : Settings : Stop Report : r) ()
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
       a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
tag (Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
 -> Sem (Stop TagsError : Settings : Stop Report : r) ())
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
-> Sem (Stop TagsError : Settings : Stop Report : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Lock : Stop TagsError : Settings : Stop Report : r) [()]
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
forall (r :: EffectRow) a. Member Lock r => Sem r a -> Sem r ()
lockOrSkip_ do
      [Maybe (Either TagsError ())]
res <- [Sem
   (Lock : Stop TagsError : Settings : Stop Report : r)
   (Either TagsError ())]
-> Sem
     (Lock : Stop TagsError : Settings : Stop Report : r)
     [Maybe (Either TagsError ())]
forall (t :: * -> *) (r :: EffectRow) a.
(Traversable t, Member Async r) =>
t (Sem r a) -> Sem r (t (Maybe a))
sequenceConcurrently (Sem
  (Stop TagsError
     : Lock : Stop TagsError : Settings : Stop Report : r)
  ()
-> Sem
     (Lock : Stop TagsError : Settings : Stop Report : r)
     (Either TagsError ())
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem
   (Stop TagsError
      : Lock : Stop TagsError : Settings : Stop Report : r)
   ()
 -> Sem
      (Lock : Stop TagsError : Settings : Stop Report : r)
      (Either TagsError ()))
-> (Project
    -> Sem
         (Stop TagsError
            : Lock : Stop TagsError : Settings : Stop Report : r)
         ())
-> Project
-> Sem
     (Lock : Stop TagsError : Settings : Stop Report : r)
     (Either TagsError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project
-> Sem
     (Stop TagsError
        : Lock : Stop TagsError : Settings : Stop Report : r)
     ()
forall (r :: EffectRow).
Members
  '[Settings !! SettingError, Settings, Reports, Stop TagsError, Log,
    Resource, Embed IO]
  r =>
Project -> Sem r ()
projectTags (Project
 -> Sem
      (Lock : Stop TagsError : Settings : Stop Report : r)
      (Either TagsError ()))
-> [Project]
-> [Sem
      (Lock : Stop TagsError : Settings : Stop Report : r)
      (Either TagsError ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Project
main Project -> [Project] -> [Project]
forall a. a -> [a] -> [a]
: [Project]
extra)
      (Maybe (Either TagsError ())
 -> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ())
-> [Maybe (Either TagsError ())]
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
 -> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ())
-> (Maybe (Either TagsError ())
    -> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ())
-> Maybe (Either TagsError ())
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TagsError ()
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
forall err (r :: EffectRow) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither (Either TagsError ()
 -> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ())
-> (Maybe (Either TagsError ()) -> Either TagsError ())
-> Maybe (Either TagsError ())
-> Sem (Lock : Stop TagsError : Settings : Stop Report : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TagsError ()
-> Maybe (Either TagsError ()) -> Either TagsError ()
forall a. a -> Maybe a -> a
fromMaybe Either TagsError ()
forall (f :: * -> *). Applicative f => f ()
unit) [Maybe (Either TagsError ())]
res