{-# LANGUAGE BlockArguments #-}

module Hercules.CLI.Nix where

import Control.Concurrent.Async (mapConcurrently)
import Control.Monad.IO.Unlift (unliftIO)
import Data.Has (Has)
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration (InputDeclaration (SiblingInput))
import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration as InputDeclaration
import qualified Hercules.API.Inputs.ImmutableGitInput as API.ImmutableGitInput
import Hercules.API.Projects (getJobSource)
import Hercules.Agent.NixFile (getVirtualValueByPath)
import qualified Hercules.Agent.NixFile.GitSource as GitSource
import Hercules.Agent.NixFile.HerculesCIArgs (CISystems (CISystems), HerculesCIArgs)
import qualified Hercules.Agent.NixFile.HerculesCIArgs as HerculesCIArgs
import Hercules.CLI.Client (HerculesClientEnv, HerculesClientToken, determineDefaultApiBaseUrl, runHerculesClient)
import Hercules.CLI.Common (runAuthenticated)
import Hercules.CLI.Git (getGitRoot, getRef, getRev, getUpstreamURL, guessForgeTypeFromURL)
import Hercules.CLI.Options (scanOption)
import Hercules.CLI.Project (ProjectPath (projectPathProject), getProjectPath, projectPathReadM, projectResourceClientByPath)
import Hercules.CNix (Store)
import Hercules.CNix.Expr as Expr (EvalState, Match (IsAttrs), NixAttrs, RawValue, Value, getAttr, getAttrs, getFlakeFromGit, init, isDerivation, match', toValue, withEvalState, withStore)
import qualified Hercules.CNix.Util as CNix.Util
import qualified Hercules.CNix.Verbosity as CNix.Verbosity
import Options.Applicative as Optparse
import Options.Applicative.Types (unReadM)
import Protolude hiding (evalState)
import RIO (RIO)
import UnliftIO (MonadUnliftIO, UnliftIO (UnliftIO), askUnliftIO)

createHerculesCIArgs :: Maybe Text -> IO HerculesCIArgs
createHerculesCIArgs :: Maybe Text -> IO HerculesCIArgs
createHerculesCIArgs Maybe Text
passedRef = do
  String
gitRoot <- IO String
getGitRoot
  Text
gitRev <- IO Text
getRev
  Text
ref <- Maybe Text -> IO Text
computeRef Maybe Text
passedRef
  Text
upstreamURL <- IO Text
getUpstreamURL
  let remoteHttpUrl :: Maybe Text
remoteHttpUrl = Text
upstreamURL Text -> Maybe () -> Maybe Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
"http" Text -> Text -> Bool
`T.isPrefixOf` Text
upstreamURL)
      remoteSshUrl :: Maybe Text
remoteSshUrl = Text
upstreamURL Text -> Maybe () -> Maybe Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text
"http" Text -> Text -> Bool
`T.isPrefixOf` Text
upstreamURL))
      guessWebUrlFromHttpUrl :: Text -> Text
guessWebUrlFromHttpUrl Text
url = Text -> Text -> Maybe Text
T.stripSuffix Text
".git" Text
url Maybe Text -> (Maybe Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
url
  let gitSource :: GitSource
gitSource =
        GitSource :: Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> GitSource
GitSource.GitSource
          { outPath :: Text
outPath = String -> Text
forall a b. ConvertText a b => a -> b
toS String
gitRoot,
            ref :: Text
ref = Text
ref,
            rev :: Text
rev = Text
gitRev,
            shortRev :: Text
shortRev = Text -> Text
GitSource.shortRevFromRev Text
gitRev,
            branch :: Maybe Text
branch = Text -> Maybe Text
GitSource.branchFromRef Text
ref,
            tag :: Maybe Text
tag = Text -> Maybe Text
GitSource.tagFromRef Text
ref,
            remoteHttpUrl :: Maybe Text
remoteHttpUrl = Maybe Text
remoteHttpUrl,
            remoteSshUrl :: Maybe Text
remoteSshUrl = Maybe Text
remoteSshUrl,
            webUrl :: Maybe Text
webUrl = Text -> Text
guessWebUrlFromHttpUrl (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
remoteHttpUrl,
            forgeType :: Maybe Text
forgeType = Text -> Maybe Text
guessForgeTypeFromURL Text
upstreamURL,
            owner :: Maybe Text
owner = Maybe Text
forall a. Maybe a
Nothing {- TODO; agent only for now -},
            name :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing {- TODO; agent only for now -}
          }
  Text
url <- IO Text
determineDefaultApiBaseUrl
  HerculesCIArgs -> IO HerculesCIArgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HerculesCIArgs -> IO HerculesCIArgs)
-> HerculesCIArgs -> IO HerculesCIArgs
forall a b. (a -> b) -> a -> b
$ GitSource -> HerculesCIMeta -> HerculesCIArgs
HerculesCIArgs.fromGitSource GitSource
gitSource HerculesCIMeta :: Text -> CISystems -> HerculesCIMeta
HerculesCIArgs.HerculesCIMeta {apiBaseUrl :: Text
apiBaseUrl = Text
url, ciSystems :: CISystems
ciSystems = Maybe (Map Text ()) -> CISystems
CISystems Maybe (Map Text ())
forall a. Maybe a
Nothing}

computeRef :: Maybe Text -> IO Text
computeRef :: Maybe Text -> IO Text
computeRef Maybe Text
Nothing = IO Text
getRef
computeRef (Just Text
passedRef) = Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
passedRef

resolveInputs ::
  (Has HerculesClientToken r, Has HerculesClientEnv r) =>
  UnliftIO (RIO r) ->
  Ptr EvalState ->
  Maybe ProjectPath ->
  Map ByteString InputDeclaration ->
  IO (Value NixAttrs)
resolveInputs :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
UnliftIO (RIO r)
-> Ptr EvalState
-> Maybe ProjectPath
-> Map ByteString InputDeclaration
-> IO (Value NixAttrs)
resolveInputs UnliftIO (RIO r)
uio Ptr EvalState
evalState Maybe ProjectPath
projectMaybe Map ByteString InputDeclaration
inputs = do
  ProjectPath
projectPath <- UnliftIO (RIO r) -> forall a. RIO r a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO (RIO r)
uio (RIO r ProjectPath -> IO ProjectPath)
-> RIO r ProjectPath -> IO ProjectPath
forall a b. (a -> b) -> a -> b
$ Maybe ProjectPath -> RIO r ProjectPath
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r ProjectPath
getProjectPath Maybe ProjectPath
projectMaybe
  let resolveInput :: ByteString -> InputDeclaration -> IO RawValue
      resolveInput :: ByteString -> InputDeclaration -> IO RawValue
resolveInput ByteString
_name (SiblingInput SiblingInput
input) = UnliftIO (RIO r) -> forall a. RIO r a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO (RIO r)
uio do
        let resourceClient :: ProjectResourceGroup ClientAuth (AsClientT ClientM)
resourceClient = ProjectPath -> ProjectResourceGroup ClientAuth (AsClientT ClientM)
projectResourceClientByPath (ProjectPath
projectPath {projectPathProject :: Text
projectPathProject = SiblingInput -> Text
InputDeclaration.project SiblingInput
input})
            jobNames :: [a]
jobNames = []
        ImmutableGitInput
immutableGitInput <- (Token -> ClientM ImmutableGitInput) -> RIO r ImmutableGitInput
forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r a
runHerculesClient (ProjectResourceGroup ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
   :- (Summary
         "Get source information from the latest successful job/jobs satisfying the provided requirements."
       :> (Description
             "The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
           :> ("source"
               :> (QueryParam'
                     '[Optional,
                       Description
                         "Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
                     "ref"
                     Text
                   :> (QueryParams "jobs" Text
                       :> (ClientAuth :> Get '[JSON] ImmutableGitInput))))))
forall auth f.
ProjectResourceGroup auth f
-> f
   :- (Summary
         "Get source information from the latest successful job/jobs satisfying the provided requirements."
       :> (Description
             "The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
           :> ("source"
               :> (QueryParam'
                     '[Optional,
                       Description
                         "Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
                     "ref"
                     Text
                   :> (QueryParams "jobs" Text
                       :> (auth :> Get '[JSON] ImmutableGitInput))))))
getJobSource ProjectResourceGroup ClientAuth (AsClientT ClientM)
resourceClient (SiblingInput -> Maybe Text
InputDeclaration.ref SiblingInput
input) [Text]
forall a. [a]
jobNames)
        IO RawValue -> RIO r RawValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RawValue -> RIO r RawValue) -> IO RawValue -> RIO r RawValue
forall a b. (a -> b) -> a -> b
$ Ptr EvalState -> ImmutableGitInput -> IO RawValue
mkImmutableGitInputFlakeThunk Ptr EvalState
evalState ImmutableGitInput
immutableGitInput
      resolveInput ByteString
_name InputDeclaration.BogusInput {} = Text -> IO RawValue
forall a. HasCallStack => Text -> a
panic Text
"resolveInput: not implemented yet"
  Map ByteString InputDeclaration
inputs
    Map ByteString InputDeclaration
-> (Map ByteString InputDeclaration
    -> Map ByteString (ByteString, InputDeclaration))
-> Map ByteString (ByteString, InputDeclaration)
forall a b. a -> (a -> b) -> b
& (ByteString -> InputDeclaration -> (ByteString, InputDeclaration))
-> Map ByteString InputDeclaration
-> Map ByteString (ByteString, InputDeclaration)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (,)
    Map ByteString (ByteString, InputDeclaration)
-> (Map ByteString (ByteString, InputDeclaration)
    -> IO (Map ByteString RawValue))
-> IO (Map ByteString RawValue)
forall a b. a -> (a -> b) -> b
& ((ByteString, InputDeclaration) -> IO RawValue)
-> Map ByteString (ByteString, InputDeclaration)
-> IO (Map ByteString RawValue)
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently ((ByteString -> InputDeclaration -> IO RawValue)
-> (ByteString, InputDeclaration) -> IO RawValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> InputDeclaration -> IO RawValue
resolveInput)
    IO (Map ByteString RawValue)
-> (IO (Map ByteString RawValue) -> IO (Value NixAttrs))
-> IO (Value NixAttrs)
forall a b. a -> (a -> b) -> b
& (IO (Map ByteString RawValue)
-> (Map ByteString RawValue -> IO (Value NixAttrs))
-> IO (Value NixAttrs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr EvalState
-> Map ByteString RawValue
-> IO (Value (NixTypeFor (Map ByteString RawValue)))
forall a.
ToValue a =>
Ptr EvalState -> a -> IO (Value (NixTypeFor a))
toValue Ptr EvalState
evalState)

refBranchToRef :: Maybe Text -> Maybe Text -> Maybe Text
refBranchToRef :: Maybe Text -> Maybe Text -> Maybe Text
refBranchToRef Maybe Text
ref Maybe Text
branch = Maybe Text
ref Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text
"refs/heads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
branch)

withNix :: (MonadUnliftIO m) => (Store -> Ptr EvalState -> m b) -> m b
withNix :: forall (m :: * -> *) b.
MonadUnliftIO m =>
(Store -> Ptr EvalState -> m b) -> m b
withNix Store -> Ptr EvalState -> m b
f = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    IO ()
Expr.init
    IO ()
CNix.Util.installDefaultSigINTHandler
  UnliftIO forall a. m a -> IO a
uio <- m (UnliftIO m)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ (Store -> IO b) -> IO b
forall (m :: * -> *) a. MonadUnliftIO m => (Store -> m a) -> m a
withStore \Store
store -> Store -> (Ptr EvalState -> IO b) -> IO b
forall a. Store -> (Ptr EvalState -> IO a) -> IO a
withEvalState Store
store (m b -> IO b
forall a. m a -> IO a
uio (m b -> IO b) -> (Ptr EvalState -> m b) -> Ptr EvalState -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store -> Ptr EvalState -> m b
f Store
store)

ciNixAttributeCompleter :: Optparse.Completer
ciNixAttributeCompleter :: Completer
ciNixAttributeCompleter = (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkTextCompleter \Text
partial -> do
  (Store -> Ptr EvalState -> IO [(CompletionItemOptions, Text)])
-> IO [(CompletionItemOptions, Text)]
forall (m :: * -> *) b.
MonadUnliftIO m =>
(Store -> Ptr EvalState -> m b) -> m b
withNix \Store
_store Ptr EvalState
evalState -> do
    Verbosity -> IO ()
CNix.Verbosity.setVerbosity Verbosity
CNix.Verbosity.Error
    Maybe Text
ref <- do
      Maybe Text
ref <- Text -> IO (Maybe Text)
scanOption Text
"--as-ref"
      Maybe Text
branch <- Text -> IO (Maybe Text)
scanOption Text
"--as-branch"
      Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> Maybe Text
refBranchToRef Maybe Text
ref Maybe Text
branch
    Maybe ProjectPath
projectMaybe <-
      Text -> IO (Maybe Text)
scanOption Text
"--project" IO (Maybe Text)
-> (Maybe Text -> Maybe ProjectPath) -> IO (Maybe ProjectPath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
maybeStr -> do
        Text
s <- Maybe Text
maybeStr
        Either ParseError ProjectPath -> Maybe ProjectPath
forall l r. Either l r -> Maybe r
rightToMaybe (Except ParseError ProjectPath -> Either ParseError ProjectPath
forall e a. Except e a -> Either e a
runExcept (ReaderT String (Except ParseError) ProjectPath
-> String -> Except ParseError ProjectPath
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReadM ProjectPath -> ReaderT String (Except ParseError) ProjectPath
forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM ReadM ProjectPath
projectPathReadM) (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
s)))
    HerculesCIArgs
args <- Maybe Text -> IO HerculesCIArgs
createHerculesCIArgs Maybe Text
ref
    let partialComponents :: [Text]
partialComponents = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
partial
        prefix :: [Text]
prefix = [Text] -> [Text]
forall a. [a] -> [a]
L.init [Text]
partialComponents
        partialComponent :: Text
partialComponent = [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay [Text]
partialComponents Maybe Text -> (Maybe Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
""
        prefixStr :: Text
prefixStr = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
prefix
        addPrefix :: Text -> Text
addPrefix Text
x = Text -> [Text] -> Text
T.intercalate Text
"." ([Text]
prefix [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
x])
    RIO
  (HerculesClientToken, HerculesClientEnv)
  [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall b. RIO (HerculesClientToken, HerculesClientEnv) b -> IO b
runAuthenticated do
      UnliftIO (RIO (HerculesClientToken, HerculesClientEnv))
uio <- RIO
  (HerculesClientToken, HerculesClientEnv)
  (UnliftIO (RIO (HerculesClientToken, HerculesClientEnv)))
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
      IO [(CompletionItemOptions, Text)]
-> RIO
     (HerculesClientToken, HerculesClientEnv)
     [(CompletionItemOptions, Text)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(CompletionItemOptions, Text)]
 -> RIO
      (HerculesClientToken, HerculesClientEnv)
      [(CompletionItemOptions, Text)])
-> IO [(CompletionItemOptions, Text)]
-> RIO
     (HerculesClientToken, HerculesClientEnv)
     [(CompletionItemOptions, Text)]
forall a b. (a -> b) -> a -> b
$
        Ptr EvalState
-> String
-> HerculesCIArgs
-> (Map ByteString InputDeclaration -> IO (Value NixAttrs))
-> [ByteString]
-> IO (Maybe RawValue)
getVirtualValueByPath Ptr EvalState
evalState (Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ GitSource -> Text
GitSource.outPath (GitSource -> Text) -> GitSource -> Text
forall a b. (a -> b) -> a -> b
$ HerculesCIArgs -> GitSource
HerculesCIArgs.primaryRepo HerculesCIArgs
args) HerculesCIArgs
args (UnliftIO (RIO (HerculesClientToken, HerculesClientEnv))
-> Ptr EvalState
-> Maybe ProjectPath
-> Map ByteString InputDeclaration
-> IO (Value NixAttrs)
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
UnliftIO (RIO r)
-> Ptr EvalState
-> Maybe ProjectPath
-> Map ByteString InputDeclaration
-> IO (Value NixAttrs)
resolveInputs UnliftIO (RIO (HerculesClientToken, HerculesClientEnv))
uio Ptr EvalState
evalState Maybe ProjectPath
projectMaybe) (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
prefix) IO (Maybe RawValue)
-> (Maybe RawValue -> IO [(CompletionItemOptions, Text)])
-> IO [(CompletionItemOptions, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe RawValue
Nothing -> [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          Just RawValue
focusValue -> do
            Ptr EvalState -> RawValue -> IO Match
match' Ptr EvalState
evalState RawValue
focusValue IO Match
-> (Match -> IO [(CompletionItemOptions, Text)])
-> IO [(CompletionItemOptions, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              IsAttrs Value NixAttrs
attrset -> do
                Map ByteString RawValue
attrs <- Ptr EvalState -> Value NixAttrs -> IO (Map ByteString RawValue)
getAttrs Ptr EvalState
evalState Value NixAttrs
attrset
                Bool
isDeriv <- Ptr EvalState -> RawValue -> IO Bool
isDerivation Ptr EvalState
evalState RawValue
focusValue
                if Bool
isDeriv
                  then [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(CompletionItemOptions
forall a. Monoid a => a
mempty {cioFiles :: Bool
Optparse.cioFiles = Bool
False}, Text
prefixStr)]
                  else
                    let matches :: [Text]
matches =
                          Map ByteString RawValue
attrs
                            Map ByteString RawValue
-> (Map ByteString RawValue -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
& Map ByteString RawValue -> [ByteString]
forall k a. Map k a -> [k]
M.keys
                            [ByteString] -> ([ByteString] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ByteString -> Text
decodeUtf8
                            [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"recurseForDerivations")
                            [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isPrefixOf Text
partialComponent)
                     in case [Text]
matches of
                          [Text
singleMatch] -> do
                            Maybe RawValue
ma <- Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
attrset (Text -> ByteString
encodeUtf8 Text
singleMatch)
                            Bool
matchIsDeriv <-
                              Maybe RawValue
ma Maybe RawValue
-> (Maybe RawValue -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. a -> (a -> b) -> b
& (RawValue -> IO Bool) -> Maybe RawValue -> IO (Maybe Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Ptr EvalState -> RawValue -> IO Bool
isDerivation Ptr EvalState
evalState)
                                IO (Maybe Bool) -> (Maybe Bool -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False
                            if Bool
matchIsDeriv
                              then
                                [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionItemOptions, Text)]
 -> IO [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall a b. (a -> b) -> a -> b
$
                                  [Text]
matches
                                    [Text]
-> ([Text] -> [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
forall a b. a -> (a -> b) -> b
& (Text -> (CompletionItemOptions, Text))
-> [Text] -> [(CompletionItemOptions, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
match -> (CompletionItemOptions
forall a. Monoid a => a
mempty {cioAddSpace :: Bool
Optparse.cioAddSpace = Bool
True, cioFiles :: Bool
Optparse.cioFiles = Bool
False}, Text -> Text
addPrefix Text
match))
                              else
                                [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionItemOptions, Text)]
 -> IO [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall a b. (a -> b) -> a -> b
$
                                  [Text]
matches
                                    [Text]
-> ([Text] -> [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
forall a b. a -> (a -> b) -> b
& (Text -> (CompletionItemOptions, Text))
-> [Text] -> [(CompletionItemOptions, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
match -> (CompletionItemOptions
forall a. Monoid a => a
mempty {cioAddSpace :: Bool
Optparse.cioAddSpace = Bool
False, cioFiles :: Bool
Optparse.cioFiles = Bool
False}, Text -> Text
addPrefix Text
match Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."))
                          [Text]
_ ->
                            [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionItemOptions, Text)]
 -> IO [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall a b. (a -> b) -> a -> b
$
                              [Text]
matches
                                [Text]
-> ([Text] -> [(CompletionItemOptions, Text)])
-> [(CompletionItemOptions, Text)]
forall a b. a -> (a -> b) -> b
& (Text -> (CompletionItemOptions, Text))
-> [Text] -> [(CompletionItemOptions, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text
match -> (CompletionItemOptions
forall a. Monoid a => a
mempty {cioAddSpace :: Bool
Optparse.cioAddSpace = Bool
False, cioFiles :: Bool
Optparse.cioFiles = Bool
False}, Text -> Text
addPrefix Text
match))
              Match
_ -> [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath :: Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
_ RawValue
v [] = Maybe RawValue -> IO (Maybe RawValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawValue -> Maybe RawValue
forall a. a -> Maybe a
Just RawValue
v)
attrByPath Ptr EvalState
evalState RawValue
v (ByteString
a : [ByteString]
as) = do
  Ptr EvalState -> RawValue -> IO Match
match' Ptr EvalState
evalState RawValue
v IO Match -> (Match -> IO (Maybe RawValue)) -> IO (Maybe RawValue)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    IsAttrs Value NixAttrs
attrs ->
      Ptr EvalState
-> Value NixAttrs -> ByteString -> IO (Maybe RawValue)
getAttr Ptr EvalState
evalState Value NixAttrs
attrs ByteString
a
        IO (Maybe RawValue)
-> (Maybe RawValue -> IO (Maybe (Maybe RawValue)))
-> IO (Maybe (Maybe RawValue))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RawValue -> IO (Maybe RawValue))
-> Maybe RawValue -> IO (Maybe (Maybe RawValue))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\RawValue
attrValue -> Ptr EvalState -> RawValue -> [ByteString] -> IO (Maybe RawValue)
attrByPath Ptr EvalState
evalState RawValue
attrValue [ByteString]
as)
        IO (Maybe (Maybe RawValue))
-> (IO (Maybe (Maybe RawValue)) -> IO (Maybe RawValue))
-> IO (Maybe RawValue)
forall a b. a -> (a -> b) -> b
& (Maybe (Maybe RawValue) -> Maybe RawValue)
-> IO (Maybe (Maybe RawValue)) -> IO (Maybe RawValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe RawValue) -> Maybe RawValue
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    Match
_ -> Maybe RawValue -> IO (Maybe RawValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RawValue
forall a. Maybe a
Nothing

mkTextCompleter :: (Text -> IO [(Optparse.CompletionItemOptions, Text)]) -> Completer
mkTextCompleter :: (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkTextCompleter Text -> IO [(CompletionItemOptions, Text)]
f = (String -> IO [CompletionItem]) -> Completer
Optparse.mkCompleterWithOptions (([(CompletionItemOptions, Text)] -> [CompletionItem])
-> IO [(CompletionItemOptions, Text)] -> IO [CompletionItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CompletionItemOptions, Text) -> CompletionItem)
-> [(CompletionItemOptions, Text)] -> [CompletionItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CompletionItemOptions -> String -> CompletionItem)
-> (CompletionItemOptions, String) -> CompletionItem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CompletionItemOptions -> String -> CompletionItem
CompletionItem ((CompletionItemOptions, String) -> CompletionItem)
-> ((CompletionItemOptions, Text)
    -> (CompletionItemOptions, String))
-> (CompletionItemOptions, Text)
-> CompletionItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String)
-> (CompletionItemOptions, Text) -> (CompletionItemOptions, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall a b. ConvertText a b => a -> b
toS)) (IO [(CompletionItemOptions, Text)] -> IO [CompletionItem])
-> (String -> IO [(CompletionItemOptions, Text)])
-> String
-> IO [CompletionItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO [(CompletionItemOptions, Text)]
f (Text -> IO [(CompletionItemOptions, Text)])
-> (String -> Text) -> String -> IO [(CompletionItemOptions, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertText a b => a -> b
toS)

mkImmutableGitInputFlakeThunk :: Ptr EvalState -> API.ImmutableGitInput.ImmutableGitInput -> IO RawValue
mkImmutableGitInputFlakeThunk :: Ptr EvalState -> ImmutableGitInput -> IO RawValue
mkImmutableGitInputFlakeThunk Ptr EvalState
evalState ImmutableGitInput
git = do
  -- TODO: allow picking ssh/http url
  Ptr EvalState -> Text -> Text -> Text -> IO RawValue
getFlakeFromGit
    Ptr EvalState
evalState
    (ImmutableGitInput -> Text
API.ImmutableGitInput.httpURL ImmutableGitInput
git)
    (ImmutableGitInput -> Text
API.ImmutableGitInput.ref ImmutableGitInput
git)
    (ImmutableGitInput -> Text
API.ImmutableGitInput.rev ImmutableGitInput
git)