{-# 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.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 Hercules.API.Attribute (attributePathFromString, attributePathToString)
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 a b. a -> Maybe b -> Maybe a
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 a b. a -> Maybe b -> Maybe a
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.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 a. a -> IO a
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 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 a. a -> IO a
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 a. IO a -> RIO r a
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 a b. IO a -> (a -> IO b) -> IO b
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 a. Maybe a -> Maybe a -> Maybe a
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 a. IO a -> m a
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 a. IO a -> m a
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)

mkSemanticTextCompleter :: (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkSemanticTextCompleter :: (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkSemanticTextCompleter Text -> IO [(CompletionItemOptions, Text)]
f =
  (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkTextCompleter
    ( \Text
input -> do
        let startsEscape :: Bool
startsEscape = Text
input Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.reverse Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text -> (Text -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Text -> Int
T.length Int -> (Int -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Int -> Bool
forall a. Integral a => a -> Bool
odd
            innerCompleter :: Text -> IO [(CompletionItemOptions, Text)]
innerCompleter = (Text -> Text)
-> (Text -> Text)
-> (Text -> IO [(CompletionItemOptions, Text)])
-> Text
-> IO [(CompletionItemOptions, Text)]
forall b a.
(b -> a)
-> (a -> b)
-> (a -> IO [(CompletionItemOptions, a)])
-> b
-> IO [(CompletionItemOptions, b)]
isoCompleter Text -> Text
decodeBash Text -> Text
encodeBash Text -> IO [(CompletionItemOptions, Text)]
f
        if Bool
startsEscape
          then do
            [(CompletionItemOptions, Text)]
r <- Text -> IO [(CompletionItemOptions, Text)]
innerCompleter (Int -> Text -> Text
T.dropEnd Int
1 Text
input)
            -- Requiring input to be a prefix of the suggestions prevents corrections,
            -- so we only filter when necessary.
            [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              [ (CompletionItemOptions, Text)
item
                | item :: (CompletionItemOptions, Text)
item@(CompletionItemOptions
_, Text
suggestionText) <- [(CompletionItemOptions, Text)]
r,
                  Text
input Text -> Text -> Bool
`T.isPrefixOf` Text
suggestionText
              ]
          else Text -> IO [(CompletionItemOptions, Text)]
innerCompleter Text
input
    )

mkAttributePathCompleter :: (([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))]) -> Completer
mkAttributePathCompleter :: (([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))])
-> Completer
mkAttributePathCompleter ([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))]
f =
  (Text -> IO [(CompletionItemOptions, Text)]) -> Completer
mkSemanticTextCompleter
    ( \Text
input -> do
        let startsEscape :: Bool
startsEscape =
              (Text
input Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.reverse Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text -> (Text -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Text -> Int
T.length Int -> (Int -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Int -> Bool
forall a. Integral a => a -> Bool
odd)
                Bool -> Bool -> Bool
|| (Text
".\"" Text -> Text -> Bool
`T.isSuffixOf` Text
input)
            decode :: Text -> ([Text], Text)
decode Text
s
              | Text
".\"\"" Text -> Text -> Bool
`T.isSuffixOf` Text
s =
                  (Text -> [Text]
attributePathFromString Text
s, Text
"")
            decode Text
s =
              let path :: [Text]
path = Text -> [Text]
attributePathFromString Text
s
               in ([Text] -> [Text]
forall a. [a] -> [a]
initSafe [Text]
path, [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay [Text]
path 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
"")
            encode :: ([Text], Bool) -> Text
encode ([Text]
path, Bool
dot) = [Text] -> Text
attributePathToString [Text]
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
dot then Text
"." else Text
""
            innerCompleter :: Text -> IO [(CompletionItemOptions, Text)]
innerCompleter = (Text -> ([Text], Text))
-> (([Text], Bool) -> Text)
-> (([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))])
-> Text
-> IO [(CompletionItemOptions, Text)]
forall a b c d.
(a -> b)
-> (c -> d)
-> (b -> IO [(CompletionItemOptions, c)])
-> a
-> IO [(CompletionItemOptions, d)]
nestedCompleter Text -> ([Text], Text)
decode ([Text], Bool) -> Text
encode ([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))]
f
        if Bool
startsEscape
          then do
            [(CompletionItemOptions, Text)]
r <- Text -> IO [(CompletionItemOptions, Text)]
innerCompleter (Int -> Text -> Text
T.dropEnd Int
1 Text
input)
            -- Requiring input to be a prefix of the suggestions prevents corrections,
            -- so we only filter when necessary.
            [(CompletionItemOptions, Text)]
-> IO [(CompletionItemOptions, Text)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              [ (CompletionItemOptions, Text)
item
                | item :: (CompletionItemOptions, Text)
item@(CompletionItemOptions
_, Text
suggestionText) <- [(CompletionItemOptions, Text)]
r,
                  Text
input Text -> Text -> Bool
`T.isPrefixOf` Text
suggestionText
              ]
          else Text -> IO [(CompletionItemOptions, Text)]
innerCompleter Text
input
    )

isoCompleter :: (b -> a) -> (a -> b) -> (a -> IO [(CompletionItemOptions, a)]) -> (b -> IO [(CompletionItemOptions, b)])
isoCompleter :: forall b a.
(b -> a)
-> (a -> b)
-> (a -> IO [(CompletionItemOptions, a)])
-> b
-> IO [(CompletionItemOptions, b)]
isoCompleter = (b -> a)
-> (a -> b)
-> (a -> IO [(CompletionItemOptions, a)])
-> b
-> IO [(CompletionItemOptions, b)]
forall a b c d.
(a -> b)
-> (c -> d)
-> (b -> IO [(CompletionItemOptions, c)])
-> a
-> IO [(CompletionItemOptions, d)]
nestedCompleter

nestedCompleter :: (a -> b) -> (c -> d) -> (b -> IO [(CompletionItemOptions, c)]) -> (a -> IO [(CompletionItemOptions, d)])
nestedCompleter :: forall a b c d.
(a -> b)
-> (c -> d)
-> (b -> IO [(CompletionItemOptions, c)])
-> a
-> IO [(CompletionItemOptions, d)]
nestedCompleter a -> b
parse c -> d
unparse b -> IO [(CompletionItemOptions, c)]
f = ([(CompletionItemOptions, c)] -> [(CompletionItemOptions, d)])
-> IO [(CompletionItemOptions, c)]
-> IO [(CompletionItemOptions, d)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CompletionItemOptions, c) -> (CompletionItemOptions, d))
-> [(CompletionItemOptions, c)] -> [(CompletionItemOptions, d)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d)
-> (CompletionItemOptions, c) -> (CompletionItemOptions, d)
forall a b.
(a -> b)
-> (CompletionItemOptions, a) -> (CompletionItemOptions, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
unparse)) (IO [(CompletionItemOptions, c)]
 -> IO [(CompletionItemOptions, d)])
-> (a -> IO [(CompletionItemOptions, c)])
-> a
-> IO [(CompletionItemOptions, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> IO [(CompletionItemOptions, c)]
f (b -> IO [(CompletionItemOptions, c)])
-> (a -> b) -> a -> IO [(CompletionItemOptions, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
parse

encodeBash :: Text -> Text
encodeBash :: Text -> Text
encodeBash = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. ConvertText a b => a -> b
toS
  where
    f :: String -> String
f (Char
'"' : String
s) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
s
    f (Char
'\'' : String
s) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
s
    f (Char
'\\' : String
s) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
s
    f (Char
' ' : String
s) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
s
    f (Char
c : String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
s
    f String
"" = String
""

decodeBash :: Text -> Text
decodeBash :: Text -> Text
decodeBash = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
g (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. ConvertText a b => a -> b
toS
  where
    g :: String -> String
g (Char
'\\' : Char
c : String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
s
    g (Char
c : String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
s
    g String
"" = String
""

ciNixAttributeCompleter :: Optparse.Completer
ciNixAttributeCompleter :: Completer
ciNixAttributeCompleter = (([Text], Text) -> IO [(CompletionItemOptions, ([Text], Bool))])
-> Completer
mkAttributePathCompleter \([Text]
partialPath, Text
partialComponent) -> do
  (Store
 -> Ptr EvalState -> IO [(CompletionItemOptions, ([Text], Bool))])
-> IO [(CompletionItemOptions, ([Text], Bool))]
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 <- (Maybe Text -> Maybe Text -> Maybe Text)
-> IO (Maybe Text) -> IO (Maybe Text) -> IO (Maybe Text)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Text -> IO (Maybe Text)
scanOption Text
"--as-ref") (Text -> IO (Maybe Text)
scanOption Text
"--pretend-ref")
      Maybe Text
branch <- (Maybe Text -> Maybe Text -> Maybe Text)
-> IO (Maybe Text) -> IO (Maybe Text) -> IO (Maybe Text)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Text -> IO (Maybe Text)
scanOption Text
"--as-branch") (Text -> IO (Maybe Text)
scanOption Text
"--pretend-branch")
      Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
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 (ExceptT ParseError Identity) ProjectPath
-> String -> Except ParseError ProjectPath
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReadM ProjectPath
-> ReaderT String (ExceptT ParseError Identity) ProjectPath
forall a. ReadM a -> ReaderT String (ExceptT ParseError Identity) 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
    RIO
  (HerculesClientToken, HerculesClientEnv)
  [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
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], Bool))]
-> RIO
     (HerculesClientToken, HerculesClientEnv)
     [(CompletionItemOptions, ([Text], Bool))]
forall a. IO a -> RIO (HerculesClientToken, HerculesClientEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(CompletionItemOptions, ([Text], Bool))]
 -> RIO
      (HerculesClientToken, HerculesClientEnv)
      [(CompletionItemOptions, ([Text], Bool))])
-> IO [(CompletionItemOptions, ([Text], Bool))]
-> RIO
     (HerculesClientToken, HerculesClientEnv)
     [(CompletionItemOptions, ([Text], Bool))]
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]
partialPath) IO (Maybe RawValue)
-> (Maybe RawValue -> IO [(CompletionItemOptions, ([Text], Bool))])
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe RawValue
Nothing -> [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a. a -> IO a
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], Bool))])
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a b. IO a -> (a -> IO b) -> IO b
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], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(CompletionItemOptions
forall a. Monoid a => a
mempty {cioFiles :: Bool
Optparse.cioFiles = Bool
False}, ([Text]
partialPath, Bool
False))]
                  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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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
                            [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionItemOptions, ([Text], Bool))]
 -> IO [(CompletionItemOptions, ([Text], Bool))])
-> [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a b. (a -> b) -> a -> b
$
                              [Text]
matches
                                [Text]
-> ([Text] -> [(CompletionItemOptions, ([Text], Bool))])
-> [(CompletionItemOptions, ([Text], Bool))]
forall a b. a -> (a -> b) -> b
& (Text -> (CompletionItemOptions, ([Text], Bool)))
-> [Text] -> [(CompletionItemOptions, ([Text], Bool))]
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
matchIsDeriv, cioFiles :: Bool
Optparse.cioFiles = Bool
False}, ([Text]
partialPath [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
match], Bool -> Bool
not Bool
matchIsDeriv)))
                          [Text]
_ ->
                            [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionItemOptions, ([Text], Bool))]
 -> IO [(CompletionItemOptions, ([Text], Bool))])
-> [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a b. (a -> b) -> a -> b
$
                              [Text]
matches
                                [Text]
-> ([Text] -> [(CompletionItemOptions, ([Text], Bool))])
-> [(CompletionItemOptions, ([Text], Bool))]
forall a b. a -> (a -> b) -> b
& (Text -> (CompletionItemOptions, ([Text], Bool)))
-> [Text] -> [(CompletionItemOptions, ([Text], Bool))]
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]
partialPath [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
match], Bool
False)))
              Match
_ -> [(CompletionItemOptions, ([Text], Bool))]
-> IO [(CompletionItemOptions, ([Text], Bool))]
forall a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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 a b. (a -> b) -> IO a -> IO b
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 a. a -> IO a
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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CompletionItemOptions, Text) -> CompletionItem)
-> [(CompletionItemOptions, Text)] -> [CompletionItem]
forall a b. (a -> b) -> [a] -> [b]
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 a b.
(a -> b)
-> (CompletionItemOptions, a) -> (CompletionItemOptions, b)
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)