{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Nix.Effects.Basic where

import           Prelude                 hiding ( traceM
                                                , head
                                                )
import           Relude.Unsafe                  ( head )
import           Nix.Utils
import           Control.Monad                  ( foldM )
import qualified Data.HashMap.Lazy             as M
import           Data.List.Split                ( splitOn )
import qualified Data.Text                     as Text
import           Prettyprinter                  ( fillSep )
import           System.FilePath
import           Nix.Convert
import           Nix.Effects
import           Nix.Exec                       ( MonadNix
                                                , evalExprLoc
                                                , nixInstantiateExpr
                                                )
import           Nix.Expr
import           Nix.Frames
import           Nix.Parser
import           Nix.Render
import           Nix.Scope
import           Nix.String
import           Nix.Value
import           Nix.Value.Monad

#ifdef MIN_VERSION_ghc_datasize
import           GHC.DataSize
#endif

defaultMakeAbsolutePath :: MonadNix e t f m => FilePath -> m FilePath
defaultMakeAbsolutePath :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[Char] -> m [Char]
defaultMakeAbsolutePath [Char]
origPath = do
  [Char]
origPathExpanded <- [Char] -> m [Char]
forall (m :: * -> *). MonadFile m => [Char] -> m [Char]
expandHomePath [Char]
origPath
  [Char]
absPath          <-
    m [Char] -> m [Char] -> Bool -> m [Char]
forall a. a -> a -> Bool -> a
bool
      (do
        [Char]
cwd <- do
          Maybe (Free (NValue' t f m) t)
mres <- Text -> m (Maybe (Free (NValue' t f m) t))
forall a (m :: * -> *). Scoped a m => Text -> m (Maybe a)
lookupVar Text
"__cur_file"
          m [Char]
-> (Free (NValue' t f m) t -> m [Char])
-> Maybe (Free (NValue' t f m) t)
-> m [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            m [Char]
forall (m :: * -> *). MonadFile m => m [Char]
getCurrentDirectory
            (
              (\case
                NVPath [Char]
s -> [Char] -> m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory [Char]
s
                Free (NValue' t f m) t
val -> ErrorCall -> m [Char]
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m [Char]) -> ErrorCall -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"when resolving relative path, __cur_file is in scope, but is not a path; it is: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Free (NValue' t f m) t -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Free (NValue' t f m) t
val
              ) (Free (NValue' t f m) t -> m [Char])
-> (Free (NValue' t f m) t -> m (Free (NValue' t f m) t))
-> Free (NValue' t f m) t
-> m [Char]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Free (NValue' t f m) t -> m (Free (NValue' t f m) t)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
            )
            Maybe (Free (NValue' t f m) t)
mres
        pure $ [Char]
cwd [Char] -> [Char] -> [Char]
<///> [Char]
origPathExpanded
      )
      ([Char] -> m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
origPathExpanded)
      ([Char] -> Bool
isAbsolute [Char]
origPathExpanded)
  [Char] -> [Char]
removeDotDotIndirections ([Char] -> [Char]) -> m [Char] -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m [Char]
forall (m :: * -> *). MonadFile m => [Char] -> m [Char]
canonicalizePath [Char]
absPath

expandHomePath :: MonadFile m => FilePath -> m FilePath
expandHomePath :: forall (m :: * -> *). MonadFile m => [Char] -> m [Char]
expandHomePath (Char
'~' : [Char]
xs) = ([Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs) ([Char] -> [Char]) -> m [Char] -> m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Char]
forall (m :: * -> *). MonadFile m => m [Char]
getHomeDirectory
expandHomePath [Char]
p          = [Char] -> m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
p

-- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@.
--   This is incorrect on POSIX systems, because if @b@ is a symlink, its
--   parent may be a different directory from @a@. See the discussion at
--   https://hackage.haskell.org/package/directory-1.3.1.5/docs/System-Directory.html#v:canonicalizePath
removeDotDotIndirections :: FilePath -> FilePath
removeDotDotIndirections :: [Char] -> [Char]
removeDotDotIndirections = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [[Char]]
forall {a}. (Eq a, IsString a) => [a] -> [a] -> [a]
go [[Char]]
forall a. Monoid a => a
mempty ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"/"
 where
  go :: [a] -> [a] -> [a]
go [a]
s       []            = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
s
  go (a
_ : [a]
s) (a
".." : [a]
rest) = [a] -> [a] -> [a]
go [a]
s [a]
rest
  go [a]
s       (a
this : [a]
rest) = [a] -> [a] -> [a]
go (a
this a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s) [a]
rest

infixr 9 <///>
(<///>) :: FilePath -> FilePath -> FilePath
[Char]
x <///> :: [Char] -> [Char] -> [Char]
<///> [Char]
y | [Char] -> Bool
isAbsolute [Char]
y Bool -> Bool -> Bool
|| [Char]
"." [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
y = [Char]
x [Char] -> [Char] -> [Char]
</> [Char]
y
          | Bool
otherwise                          = [Char] -> [Char] -> [Char]
joinByLargestOverlap [Char]
x [Char]
y
 where
  joinByLargestOverlap :: [Char] -> [Char] -> [Char]
joinByLargestOverlap ([Char] -> [[Char]]
splitDirectories -> [[Char]]
xs) ([Char] -> [[Char]]
splitDirectories -> [[Char]]
ys) =
    [[Char]] -> [Char]
joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall a. [a] -> a
head
      [ [[Char]]
xs [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop ([[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
tx) [[Char]]
ys | [[Char]]
tx <- [[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
tails [[Char]]
xs, [[Char]]
tx [[Char]] -> [[[Char]]] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
inits [[Char]]
ys ]

defaultFindEnvPath :: MonadNix e t f m => String -> m FilePath
defaultFindEnvPath :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[Char] -> m [Char]
defaultFindEnvPath = [Char] -> m [Char]
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[Char] -> m [Char]
findEnvPathM

findEnvPathM :: forall e t f m . MonadNix e t f m => FilePath -> m FilePath
findEnvPathM :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[Char] -> m [Char]
findEnvPathM [Char]
name = do
  Maybe (NValue t f m)
mres <- Text -> m (Maybe (NValue t f m))
forall a (m :: * -> *). Scoped a m => Text -> m (Maybe a)
lookupVar Text
"__nixPath"

  m [Char]
-> (NValue t f m -> m [Char]) -> Maybe (NValue t f m) -> m [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ([Char] -> m [Char]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"impossible")
    (
      (\ NValue t f m
nv ->
        do
          ([NValue t f m]
l :: [NValue t f m]) <- NValue t f m -> m [NValue t f m]
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
nv
          ([Char] -> m (Maybe [Char]))
-> [NValue t f m] -> [Char] -> m [Char]
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
([Char] -> m (Maybe [Char]))
-> [NValue t f m] -> [Char] -> m [Char]
findPathBy [Char] -> m (Maybe [Char])
MonadEffects t f m => [Char] -> m (Maybe [Char])
nixFilePath [NValue t f m]
l [Char]
name
      ) (NValue t f m -> m [Char])
-> (NValue t f m -> m (NValue t f m)) -> NValue t f m -> m [Char]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
    )
    Maybe (NValue t f m)
mres

 where
  nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
  nixFilePath :: MonadEffects t f m => [Char] -> m (Maybe [Char])
nixFilePath [Char]
path = do
    [Char]
absPath <- forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
[Char] -> m [Char]
makeAbsolutePath @t @f [Char]
path
    Bool
isDir   <- [Char] -> m Bool
forall (m :: * -> *). MonadFile m => [Char] -> m Bool
doesDirectoryExist [Char]
absPath
    [Char]
absFile <-
      m [Char] -> m [Char] -> Bool -> m [Char]
forall a. a -> a -> Bool -> a
bool
        ([Char] -> m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
absPath)
        (forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
[Char] -> m [Char]
makeAbsolutePath @t @f ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
absPath [Char] -> [Char] -> [Char]
</> [Char]
"default.nix")
        Bool
isDir
    Bool
exists <- [Char] -> m Bool
forall (m :: * -> *). MonadFile m => [Char] -> m Bool
doesFileExist [Char]
absFile
    pure $
      Maybe [Char] -> Maybe [Char] -> Bool -> Maybe [Char]
forall a. a -> a -> Bool -> a
bool
        Maybe [Char]
forall a. Monoid a => a
mempty
        ([Char] -> Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
absFile)
        Bool
exists

findPathBy
  :: forall e t f m
   . MonadNix e t f m
  => (FilePath -> m (Maybe FilePath))
  -> [NValue t f m]
  -> FilePath
  -> m FilePath
findPathBy :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
([Char] -> m (Maybe [Char]))
-> [NValue t f m] -> [Char] -> m [Char]
findPathBy [Char] -> m (Maybe [Char])
finder [NValue t f m]
ls [Char]
name = do
  Maybe [Char]
mpath <- (Maybe [Char] -> NValue t f m -> m (Maybe [Char]))
-> Maybe [Char] -> [NValue t f m] -> m (Maybe [Char])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe [Char] -> NValue t f m -> m (Maybe [Char])
go Maybe [Char]
forall a. Monoid a => a
mempty [NValue t f m]
ls
  m [Char] -> ([Char] -> m [Char]) -> Maybe [Char] -> m [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (ErrorCall -> m [Char]
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m [Char]) -> ErrorCall -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"file '" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"' was not found in the Nix search path (add it's using $NIX_PATH or -I)")
    [Char] -> m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Maybe [Char]
mpath
 where
  go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)
  go :: Maybe [Char] -> NValue t f m -> m (Maybe [Char])
go Maybe [Char]
mp =
    (NValue t f m -> m (Maybe [Char]))
-> ([Char] -> NValue t f m -> m (Maybe [Char]))
-> Maybe [Char]
-> NValue t f m
-> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (\ NValue t f m
nv ->
        do
          (HashMap Text (NValue t f m)
s :: HashMap Text (NValue t f m)) <- NValue t f m -> m (HashMap Text (NValue t f m))
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue (NValue t f m -> m (HashMap Text (NValue t f m)))
-> m (NValue t f m) -> m (HashMap Text (NValue t f m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
nv
          NValue t f m
p <- HashMap Text (NValue t f m) -> m (NValue t f m)
forall {e} {m :: * -> *} {t} {f :: * -> *} {k}.
(MonadReader e m, Scoped (NValue t f m) m,
 MonadValue (NValue t f m) m, Comonad f, Has e Frames,
 Has e Options, Has e SrcSpan, MonadFix m, MonadCatch m,
 Alternative m, MonadEffects t f m, MonadThunk t m (NValue t f m),
 Traversable f, HasCitations m (NValue t f m) t,
 HasCitations1 m (NValue t f m) f, Hashable k, IsString k,
 Applicative f, Eq k, Show t, Show k, Typeable m, Typeable f,
 Typeable t) =>
HashMap k (NValue t f m) -> m (NValue t f m)
resolvePath HashMap Text (NValue t f m)
s
          NValue t f m
nvpath <- NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
p
          (Path [Char]
path) <- NValue t f m -> m Path
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
nvpath

          m (Maybe [Char])
-> (NValue t f m -> m (Maybe [Char]))
-> Maybe (NValue t f m)
-> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([Char] -> Maybe [Char] -> m (Maybe [Char])
tryPath [Char]
path Maybe [Char]
forall a. Monoid a => a
mempty)
            (\ NValue t f m
nv' ->
              do
                Maybe NixString
mns <- NValue t f m -> m (Maybe NixString)
forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
fromValueMay (NValue t f m -> m (Maybe NixString))
-> m (NValue t f m) -> m (Maybe NixString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
nv'
                [Char] -> Maybe [Char] -> m (Maybe [Char])
tryPath [Char]
path (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
                  case Maybe NixString
mns of
                    Just (NixString
nsPfx :: NixString) ->
                      let pfx :: Text
pfx = NixString -> Text
stringIgnoreContext NixString
nsPfx in
                      Maybe [Char] -> Maybe [Char] -> Bool -> Maybe [Char]
forall a. a -> a -> Bool -> a
bool
                        Maybe [Char]
forall a. Monoid a => a
mempty
                        ([Char] -> Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
pfx))
                        (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
Text.null Text
pfx)
                    Maybe NixString
_ -> Maybe [Char]
forall a. Monoid a => a
mempty
            )
            (Text -> HashMap Text (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
"prefix" HashMap Text (NValue t f m)
s)
      )
      (m (Maybe [Char]) -> NValue t f m -> m (Maybe [Char])
forall a b. a -> b -> a
const (m (Maybe [Char]) -> NValue t f m -> m (Maybe [Char]))
-> ([Char] -> m (Maybe [Char]))
-> [Char]
-> NValue t f m
-> m (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> m (Maybe [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Char] -> m (Maybe [Char]))
-> ([Char] -> Maybe [Char]) -> [Char] -> m (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
      Maybe [Char]
mp

  tryPath :: FilePath -> Maybe FilePath -> m (Maybe FilePath)
  tryPath :: [Char] -> Maybe [Char] -> m (Maybe [Char])
tryPath [Char]
p (Just [Char]
n) | [Char]
n' : [[Char]]
ns <- [Char] -> [[Char]]
splitDirectories [Char]
name, [Char]
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
n' =
    [Char] -> m (Maybe [Char])
finder ([Char] -> m (Maybe [Char])) -> [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
p [Char] -> [Char] -> [Char]
<///> [[Char]] -> [Char]
joinPath [[Char]]
ns
  tryPath [Char]
p Maybe [Char]
_ = [Char] -> m (Maybe [Char])
finder ([Char] -> m (Maybe [Char])) -> [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
p [Char] -> [Char] -> [Char]
<///> [Char]
name

  resolvePath :: HashMap k (NValue t f m) -> m (NValue t f m)
resolvePath HashMap k (NValue t f m)
s =
    m (NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> Maybe (NValue t f m)
-> m (NValue t f m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (m (NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> Maybe (NValue t f m)
-> m (NValue t f m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"__nixPath must be a list of attr sets with 'path' elements, but received: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> HashMap k (NValue t f m) -> [Char]
forall b a. (Show a, IsString b) => a -> b
show HashMap k (NValue t f m)
s)
        (m (NValue t f m) -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m (NValue t f m) -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m (NValue t f m)
fetchTarball)
        (k -> HashMap k (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
"uri" HashMap k (NValue t f m)
s)
      )
      NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (k -> HashMap k (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
"path" HashMap k (NValue t f m)
s)

fetchTarball
  :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
fetchTarball :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NValue t f m -> m (NValue t f m)
fetchTarball =
  \case
    NVSet AttrSet (NValue t f m)
s AttrSet SourcePos
_ ->
      m (NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> Maybe (NValue t f m)
-> m (NValue t f m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall [Char]
"builtins.fetchTarball: Missing url attribute")
        (Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
go (Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
"sha256" AttrSet (NValue t f m)
s) (NValue t f m -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand)
        (Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
"url" AttrSet (NValue t f m)
s)
    v :: NValue t f m
v@NVStr{} -> Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
go Maybe (NValue t f m)
forall a. Maybe a
Nothing NValue t f m
v
    NValue t f m
v -> ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"builtins.fetchTarball: Expected URI or set, got " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> [Char]
forall b a. (Show a, IsString b) => a -> b
show NValue t f m
v
  (NValue t f m -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
 where
  go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
  go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
go Maybe (NValue t f m)
msha = \case
    NVStr NixString
ns -> Text -> Maybe (NValue t f m) -> m (NValue t f m)
fetch (NixString -> Text
stringIgnoreContext NixString
ns) Maybe (NValue t f m)
msha
    NValue t f m
v -> ErrorCall -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (NValue t f m)) -> ErrorCall -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"builtins.fetchTarball: Expected URI or string, got " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> [Char]
forall b a. (Show a, IsString b) => a -> b
show NValue t f m
v

{- jww (2018-04-11): This should be written using pipes in another module
    fetch :: Text -> Maybe (NThunk m) -> m (NValue t f m)
    fetch uri msha = case takeExtension uri of
        ".tgz" -> undefined
        ".gz"  -> undefined
        ".bz2" -> undefined
        ".xz"  -> undefined
        ".tar" -> undefined
        ext -> throwError $ ErrorCall $ "builtins.fetchTarball: Unsupported extension '"
                  <> ext <> "'"
-}

  fetch :: Text -> Maybe (NValue t f m) -> m (NValue t f m)
  fetch :: Text -> Maybe (NValue t f m) -> m (NValue t f m)
fetch Text
uri Maybe (NValue t f m)
Nothing =
    Text -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadInstantiate m) =>
Text -> m (NValue t f m)
nixInstantiateExpr (Text -> m (NValue t f m)) -> Text -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Text
"builtins.fetchTarball \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  fetch Text
url (Just NValue t f m
t) =
      (\NValue t f m
nv -> do
        NixString
nsSha <- NValue t f m -> m NixString
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue NValue t f m
nv

        let sha :: Text
sha = NixString -> Text
stringIgnoreContext NixString
nsSha

        Text -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
(MonadNix e t f m, MonadInstantiate m) =>
Text -> m (NValue t f m)
nixInstantiateExpr
          (Text -> m (NValue t f m)) -> Text -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ Text
"builtins.fetchTarball { " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"url    = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"sha256 = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sha Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"; }"
      ) (NValue t f m -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NValue t f m -> m (NValue t f m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
t

defaultFindPath :: MonadNix e t f m => [NValue t f m] -> FilePath -> m FilePath
defaultFindPath :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[NValue t f m] -> [Char] -> m [Char]
defaultFindPath = [NValue t f m] -> [Char] -> m [Char]
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[NValue t f m] -> [Char] -> m [Char]
findPathM

findPathM
  :: forall e t f m
   . MonadNix e t f m
  => [NValue t f m]
  -> FilePath
  -> m FilePath
findPathM :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[NValue t f m] -> [Char] -> m [Char]
findPathM = ([Char] -> m (Maybe [Char]))
-> [NValue t f m] -> [Char] -> m [Char]
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
([Char] -> m (Maybe [Char]))
-> [NValue t f m] -> [Char] -> m [Char]
findPathBy [Char] -> m (Maybe [Char])
MonadEffects t f m => [Char] -> m (Maybe [Char])
existingPath
 where
  existingPath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
  existingPath :: MonadEffects t f m => [Char] -> m (Maybe [Char])
existingPath [Char]
path =
    do
      [Char]
apath  <- forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
[Char] -> m [Char]
makeAbsolutePath @t @f [Char]
path
      Bool
doesExist <- [Char] -> m Bool
forall (m :: * -> *). MonadFile m => [Char] -> m Bool
doesPathExist [Char]
apath
      pure $ [Char] -> Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
apath Maybe [Char] -> Bool -> Maybe [Char]
forall a. Monoid a => a -> Bool -> a
`whenTrue` Bool
doesExist

defaultImportPath
  :: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc, b) m)
  => FilePath
  -> m (NValue t f m)
defaultImportPath :: forall e t (f :: * -> *) (m :: * -> *) b.
(MonadNix e t f m, MonadState (HashMap [Char] NExprLoc, b) m) =>
[Char] -> m (NValue t f m)
defaultImportPath [Char]
path = do
  [Char] -> m ()
forall (m :: * -> *). Monad m => [Char] -> m ()
traceM ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Importing file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path
  NixLevel -> ErrorCall -> m (NValue t f m) -> m (NValue t f m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s) =>
NixLevel -> s -> m a -> m a
withFrame NixLevel
Info ([Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall) -> [Char] -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Char]
"While importing file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall b a. (Show a, IsString b) => a -> b
show [Char]
path) (m (NValue t f m) -> m (NValue t f m))
-> m (NValue t f m) -> m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ do
    HashMap [Char] NExprLoc
imports <- ((HashMap [Char] NExprLoc, b) -> HashMap [Char] NExprLoc)
-> m (HashMap [Char] NExprLoc)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HashMap [Char] NExprLoc, b) -> HashMap [Char] NExprLoc
forall a b. (a, b) -> a
fst
    NExprLoc -> m (NValue t f m)
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
NExprLoc -> m (NValue t f m)
evalExprLoc (NExprLoc -> m (NValue t f m)) -> m NExprLoc -> m (NValue t f m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      m NExprLoc
-> (NExprLoc -> m NExprLoc) -> Maybe NExprLoc -> m NExprLoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (do
          Result NExprLoc
eres <- [Char] -> m (Result NExprLoc)
forall (m :: * -> *). MonadFile m => [Char] -> m (Result NExprLoc)
parseNixFileLoc [Char]
path
          (Doc Void -> m NExprLoc)
-> (NExprLoc -> m NExprLoc) -> Result NExprLoc -> m NExprLoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\ Doc Void
err -> ErrorCall -> m NExprLoc
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m NExprLoc) -> ErrorCall -> m NExprLoc
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall ([Char] -> ErrorCall)
-> (Doc Void -> [Char]) -> Doc Void -> ErrorCall
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Void -> [Char]
forall b a. (Show a, IsString b) => a -> b
show (Doc Void -> ErrorCall) -> Doc Void -> ErrorCall
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
fillSep [Doc Void
"Parse during import failed:", Doc Void
err])
            (\ NExprLoc
expr ->
              do
                ((HashMap [Char] NExprLoc, b) -> (HashMap [Char] NExprLoc, b))
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((HashMap [Char] NExprLoc -> HashMap [Char] NExprLoc)
-> (HashMap [Char] NExprLoc, b) -> (HashMap [Char] NExprLoc, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char]
-> NExprLoc -> HashMap [Char] NExprLoc -> HashMap [Char] NExprLoc
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert [Char]
path NExprLoc
expr))
                pure NExprLoc
expr
            )
            Result NExprLoc
eres
        )
        NExprLoc -> m NExprLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure  -- return expr
        ([Char] -> HashMap [Char] NExprLoc -> Maybe NExprLoc
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [Char]
path HashMap [Char] NExprLoc
imports)

defaultPathToDefaultNix :: MonadNix e t f m => FilePath -> m FilePath
defaultPathToDefaultNix :: forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
[Char] -> m [Char]
defaultPathToDefaultNix = [Char] -> m [Char]
forall (m :: * -> *). MonadFile m => [Char] -> m [Char]
pathToDefaultNixFile

-- Given a path, determine the nix file to load
pathToDefaultNixFile :: MonadFile m => FilePath -> m FilePath
pathToDefaultNixFile :: forall (m :: * -> *). MonadFile m => [Char] -> m [Char]
pathToDefaultNixFile [Char]
p = do
  Bool
isDir <- [Char] -> m Bool
forall (m :: * -> *). MonadFile m => [Char] -> m Bool
doesDirectoryExist [Char]
p
  pure $ [Char]
p [Char] -> [Char] -> [Char]
</> [Char]
"default.nix" [Char] -> Bool -> [Char]
forall a. Monoid a => a -> Bool -> a
`whenTrue` Bool
isDir

defaultTraceEffect :: MonadPutStr m => String -> m ()
defaultTraceEffect :: forall (m :: * -> *). MonadPutStr m => [Char] -> m ()
defaultTraceEffect = [Char] -> m ()
forall (m :: * -> *). MonadPutStr m => [Char] -> m ()
Nix.Effects.putStrLn