{-# language CPP #-}

module Nix.Effects.Basic where

import           Nix.Prelude             hiding ( head
                                                )
import           Relude.Unsafe                  ( head )
import           GHC.Exception                  ( ErrorCall(ErrorCall) )
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           Nix.Convert
import           Nix.Effects
import           Nix.Exec                       ( MonadNix
                                                , evalExprLoc
                                                , nixInstantiateExpr
                                                )
import           Nix.Expr.Types
import           Nix.Expr.Types.Annotated
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




defaultToAbsolutePath :: forall e t f m . MonadNix e t f m => Path -> m Path
defaultToAbsolutePath :: Path -> m Path
defaultToAbsolutePath Path
origPath =
  do
    Path
origPathExpanded <- Path -> m Path
forall (m :: * -> *). MonadFile m => Path -> m Path
expandHomePath Path
origPath
    (Path -> Path) -> m Path -> m Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      Path -> Path
removeDotDotIndirections
      (m Path -> m Path) -> (Path -> m Path) -> Path -> m Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> m Path
forall (m :: * -> *). MonadFile m => Path -> m Path
canonicalizePath
        (Path -> m Path) -> m Path -> m Path
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Path -> m Path -> Bool -> m Path
forall a. a -> a -> Bool -> a
bool
            ((Path -> Path) -> m Path -> m Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (Path -> Path -> Path
<///> Path
origPathExpanded)
              (m Path -> m Path) -> m Path -> m Path
forall a b. (a -> b) -> a -> b
$ m Path
-> (Free (NValue' t f m) t -> m Path)
-> Maybe (Free (NValue' t f m) t)
-> m Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  m Path
forall (m :: * -> *). MonadFile m => m Path
getCurrentDirectory
                  ( (\case
                      NVPath Path
s -> Path -> m Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> m Path) -> Path -> m Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
takeDirectory Path
s
                      Free (NValue' t f m) t
val -> ErrorCall -> m Path
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Path) -> ErrorCall -> m Path
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"when resolving relative path, __cur_file is in scope, but is not a path; it is: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Free (NValue' t f m) t -> String
forall b a. (Show a, IsString b) => a -> b
show Free (NValue' t f m) t
val
                    ) (Free (NValue' t f m) t -> m Path)
-> (Free (NValue' t f m) t -> m (Free (NValue' t f m) t))
-> Free (NValue' t f m) t
-> m Path
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) -> m Path)
-> m (Maybe (Free (NValue' t f m) t)) -> m Path
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VarName -> m (Maybe (Free (NValue' t f m) t))
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
"__cur_file"
            )
            (Path -> m Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
origPathExpanded)
            (Path -> Bool
isAbsolute Path
origPathExpanded)

expandHomePath :: MonadFile m => Path -> m Path
expandHomePath :: Path -> m Path
expandHomePath (Path -> String
coerce -> (Char
'~' : String
xs)) = (Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> String -> Path
coerce String
xs) (Path -> Path) -> m Path -> m Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Path
forall (m :: * -> *). MonadFile m => m Path
getHomeDirectory
expandHomePath Path
p          = Path -> m Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
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 :: Path -> Path
removeDotDotIndirections :: Path -> Path
removeDotDotIndirections = String -> Path
coerce (String -> Path) -> (Path -> String) -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> (Path -> [String]) -> Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
forall a. (Eq a, IsString a) => [a] -> [a] -> [a]
go [String]
forall a. Monoid a => a
mempty ([String] -> [String]) -> (Path -> [String]) -> Path -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"/" (String -> [String]) -> (Path -> String) -> Path -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
coerce
 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 <///>
(<///>) :: Path -> Path -> Path
Path
x <///> :: Path -> Path -> Path
<///> Path
y
  | Path -> Bool
isAbsolute Path
y Bool -> Bool -> Bool
|| String
"." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Path -> String
coerce Path
y = Path
x Path -> Path -> Path
</> Path
y
  | Bool
otherwise                          = Path -> Path -> Path
joinByLargestOverlap Path
x Path
y
 where
  joinByLargestOverlap :: Path -> Path -> Path
  joinByLargestOverlap :: Path -> Path -> Path
joinByLargestOverlap (Path -> [Path]
splitDirectories -> [Path]
xs) (Path -> [Path]
splitDirectories -> [Path]
ys) =
    [Path] -> Path
joinPath ([Path] -> Path) -> [Path] -> Path
forall a b. (a -> b) -> a -> b
$ [[Path]] -> [Path]
forall a. [a] -> a
head
      [ [Path]
xs [Path] -> [Path] -> [Path]
forall a. Semigroup a => a -> a -> a
<> Int -> [Path] -> [Path]
forall a. Int -> [a] -> [a]
drop ([Path] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Path]
tx) [Path]
ys | [Path]
tx <- [Path] -> [[Path]]
forall a. [a] -> [[a]]
tails [Path]
xs, [Path]
tx [Path] -> [[Path]] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Path] -> [[Path]]
forall a. [a] -> [[a]]
inits [Path]
ys ]

defaultFindEnvPath :: MonadNix e t f m => String -> m Path
defaultFindEnvPath :: String -> m Path
defaultFindEnvPath = Path -> m Path
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
Path -> m Path
findEnvPathM (Path -> m Path) -> (String -> Path) -> String -> m Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path
coerce

findEnvPathM :: forall e t f m . MonadNix e t f m => Path -> m Path
findEnvPathM :: Path -> m Path
findEnvPathM Path
name =
  m Path
-> (NValue t f m -> m Path) -> Maybe (NValue t f m) -> m Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> m Path
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"impossible")
    (\ NValue t f m
v ->
      do
        [NValue t f m]
l <- forall a (m :: * -> *) v. FromValue a m v => v -> m a
forall (m :: * -> *) v.
FromValue [NValue t f m] m v =>
v -> m [NValue t f m]
fromValue @[NValue t f m] (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
v
        (Path -> m (Maybe Path)) -> [NValue t f m] -> Path -> m Path
forall e t (f :: * -> *) (m :: * -> *).
MonadNix e t f m =>
(Path -> m (Maybe Path)) -> [NValue t f m] -> Path -> m Path
findPathBy Path -> m (Maybe Path)
MonadEffects t f m => Path -> m (Maybe Path)
nixFilePath [NValue t f m]
l Path
name
    )
    (Maybe (NValue t f m) -> m Path)
-> m (Maybe (NValue t f m)) -> m Path
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VarName -> m (Maybe (NValue t f m))
forall a (m :: * -> *). Scoped a m => VarName -> m (Maybe a)
lookupVar VarName
"__nixPath"

 where
  nixFilePath :: MonadEffects t f m => Path -> m (Maybe Path)
  nixFilePath :: Path -> m (Maybe Path)
nixFilePath Path
path =
    do
      Path
absPath <- Path -> m Path
forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
toAbsolutePath @t @f Path
path
      Bool
isDir   <- Path -> m Bool
forall (m :: * -> *). MonadFile m => Path -> m Bool
doesDirectoryExist Path
absPath
      Path
absFile <-
        m Path -> m Path -> Bool -> m Path
forall a. a -> a -> Bool -> a
bool
          (Path -> m Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
absPath)
          (forall t (f :: * -> *) (m :: * -> *).
MonadEffects t f m =>
Path -> m Path
forall (m :: * -> *). MonadEffects t f m => Path -> m Path
toAbsolutePath @t @f (Path -> m Path) -> Path -> m Path
forall a b. (a -> b) -> a -> b
$ Path
absPath Path -> Path -> Path
</> Path
"default.nix")
          Bool
isDir

      (Path -> Maybe Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
absFile Maybe Path -> Bool -> Maybe Path
forall a. Monoid a => a -> Bool -> a
`whenTrue`) (Bool -> Maybe Path) -> m Bool -> m (Maybe Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> m Bool
forall (m :: * -> *). MonadFile m => Path -> m Bool
doesFileExist Path
absFile

findPathBy
  :: forall e t f m
   . MonadNix e t f m
  => (Path -> m (Maybe Path))
  -> [NValue t f m]
  -> Path
  -> m Path
findPathBy :: (Path -> m (Maybe Path)) -> [NValue t f m] -> Path -> m Path
findPathBy Path -> m (Maybe Path)
finder [NValue t f m]
ls Path
name =
  m Path -> (Path -> m Path) -> Maybe Path -> m Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (ErrorCall -> m Path
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m Path) -> ErrorCall -> m Path
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"file ''" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Path -> String
coerce Path
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'' was not found in the Nix search path (add it's using $NIX_PATH or -I)")
    Path -> m Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Path -> m Path) -> m (Maybe Path) -> m Path
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Maybe Path -> NValue t f m -> m (Maybe Path))
-> Maybe Path -> [NValue t f m] -> m (Maybe Path)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe Path -> NValue t f m -> m (Maybe Path)
MonadNix e t f m => Maybe Path -> NValue t f m -> m (Maybe Path)
fun Maybe Path
forall a. Monoid a => a
mempty [NValue t f m]
ls
 where
  fun
    :: MonadNix e t f m
    => Maybe Path
    -> NValue t f m
    -> m (Maybe Path)
  fun :: Maybe Path -> NValue t f m -> m (Maybe Path)
fun =
    (NValue t f m -> m (Maybe Path))
-> (Path -> NValue t f m -> m (Maybe Path))
-> Maybe Path
-> NValue t f m
-> m (Maybe Path)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (\ NValue t f m
nv ->
        do
          (HashMap VarName (NValue t f m)
s :: HashMap VarName (NValue t f m)) <- NValue t f m -> m (HashMap VarName (NValue t f m))
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue (NValue t f m -> m (HashMap VarName (NValue t f m)))
-> m (NValue t f m) -> m (HashMap VarName (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 VarName (NValue t f m) -> m (NValue t f m)
resolvePath HashMap VarName (NValue t f m)
s
          Path
path <- NValue t f m -> m Path
forall a (m :: * -> *) v. FromValue a m v => v -> m a
fromValue (NValue t f m -> m Path) -> m (NValue t f m) -> m Path
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
p

          m (Maybe Path)
-> (NValue t f m -> m (Maybe Path))
-> Maybe (NValue t f m)
-> m (Maybe Path)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Path -> Maybe Path -> m (Maybe Path)
tryPath Path
path Maybe Path
forall a. Monoid a => a
mempty)
            (\ NValue t f m
nv' ->
              do
                Maybe NixString
mns <- forall a (m :: * -> *) v. FromValue a m v => v -> m (Maybe a)
forall (m :: * -> *) v.
FromValue NixString m v =>
v -> m (Maybe NixString)
fromValueMay @NixString (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'
                Path -> Maybe Path -> m (Maybe Path)
tryPath Path
path (Maybe Path -> m (Maybe Path)) -> Maybe Path -> m (Maybe Path)
forall a b. (a -> b) -> a -> b
$
                  (NixString -> Maybe Path) -> Maybe NixString -> Maybe Path
forall b a. Monoid b => (a -> b) -> Maybe a -> b
whenJust
                    (\ NixString
nsPfx ->
                      let pfx :: Text
pfx = NixString -> Text
ignoreContext NixString
nsPfx in
                      Path -> Maybe Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Maybe Path) -> Path -> Maybe Path
forall a b. (a -> b) -> a -> b
$ String -> Path
coerce (String -> Path) -> String -> Path
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
pfx String -> Bool -> String
forall a. Monoid a => a -> Bool -> a
`whenFalse` Text -> Bool
Text.null Text
pfx
                    )
                    Maybe NixString
mns
            )
            (VarName -> HashMap VarName (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
"prefix" HashMap VarName (NValue t f m)
s)
      )
      (m (Maybe Path) -> NValue t f m -> m (Maybe Path)
forall a b. a -> b -> a
const (m (Maybe Path) -> NValue t f m -> m (Maybe Path))
-> (Path -> m (Maybe Path))
-> Path
-> NValue t f m
-> m (Maybe Path)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Path -> m (Maybe Path)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Path -> m (Maybe Path))
-> (Path -> Maybe Path) -> Path -> m (Maybe Path)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Maybe Path
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

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

  resolvePath :: HashMap VarName (NValue t f m) -> m (NValue t f m)
  resolvePath :: HashMap VarName (NValue t f m) -> m (NValue t f m)
resolvePath HashMap VarName (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
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"__nixPath must be a list of attr sets with 'path' elements, but received: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HashMap VarName (NValue t f m) -> String
forall b a. (Show a, IsString b) => a -> b
show HashMap VarName (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)
        (VarName -> HashMap VarName (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
"uri" HashMap VarName (NValue t f m)
s)
      )
      NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (VarName -> HashMap VarName (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
"path" HashMap VarName (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 :: NValue t f m -> m (NValue t f m)
fetchTarball =
  \case
    NVSet PositionSet
_ AttrSet (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
        (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
$ String -> ErrorCall
ErrorCall String
"builtins.fetchTarball: Missing url attribute")
        (Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
fetchFromString (VarName -> 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 VarName
"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)
        (VarName -> 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 VarName
"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)
fetchFromString 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
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"builtins.fetchTarball: Expected URI or set, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
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
  fetchFromString
    :: Maybe (NValue t f m)
    -> NValue t f m
    -> m (NValue t f m)
  fetchFromString :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)
fetchFromString Maybe (NValue t f m)
msha =
    \case
      NVStr NixString
ns -> Text -> Maybe (NValue t f m) -> m (NValue t f m)
fetch (NixString -> Text
ignoreContext 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
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"builtins.fetchTarball: Expected URI or string, got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NValue t f m -> String
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 =
    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
      (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
"\""
      )
      (\ NValue t f m
v ->
        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 -> m NixString) -> m (NValue t f m) -> m 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
v

          let sha :: Text
sha = NixString -> Text
ignoreContext 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
uri 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
"\"; }"
      )

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

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

defaultImportPath
  :: (MonadNix e t f m, MonadState (HashMap Path NExprLoc, b) m)
  => Path
  -> m (NValue t f m)
defaultImportPath :: Path -> m (NValue t f m)
defaultImportPath Path
path =
  do
    String -> m ()
forall (m :: * -> *). Monad m => String -> m ()
traceM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Importing file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Path -> String
coerce Path
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
      (String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ String
"While importing file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Path -> String
forall b a. (Show a, IsString b) => a -> b
show Path
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
$ 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
            ((Doc Void -> m NExprLoc)
-> (NExprLoc -> m NExprLoc)
-> Either (Doc Void) 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
$ String -> ErrorCall
ErrorCall (String -> ErrorCall)
-> (Doc Void -> String) -> Doc Void -> ErrorCall
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Void -> String
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 Path NExprLoc, b) -> (HashMap Path NExprLoc, b)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((HashMap Path NExprLoc, b) -> (HashMap Path NExprLoc, b))
 -> m ())
-> ((HashMap Path NExprLoc, b) -> (HashMap Path NExprLoc, b))
-> m ()
forall a b. (a -> b) -> a -> b
$ (HashMap Path NExprLoc -> HashMap Path NExprLoc)
-> (HashMap Path NExprLoc, b) -> (HashMap Path NExprLoc, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((HashMap Path NExprLoc -> HashMap Path NExprLoc)
 -> (HashMap Path NExprLoc, b) -> (HashMap Path NExprLoc, b))
-> (HashMap Path NExprLoc -> HashMap Path NExprLoc)
-> (HashMap Path NExprLoc, b)
-> (HashMap Path NExprLoc, b)
forall a b. (a -> b) -> a -> b
$ Path -> NExprLoc -> HashMap Path NExprLoc -> HashMap Path NExprLoc
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Path
path NExprLoc
expr
                  pure NExprLoc
expr
              )
              (Either (Doc Void) NExprLoc -> m NExprLoc)
-> m (Either (Doc Void) NExprLoc) -> m NExprLoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path -> m (Either (Doc Void) NExprLoc)
forall (m :: * -> *).
MonadFile m =>
Path -> m (Either (Doc Void) NExprLoc)
parseNixFileLoc Path
path
            )
            NExprLoc -> m NExprLoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure  -- return expr
            (Maybe NExprLoc -> m NExprLoc)
-> (HashMap Path NExprLoc -> Maybe NExprLoc)
-> HashMap Path NExprLoc
-> m NExprLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> HashMap Path NExprLoc -> Maybe NExprLoc
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Path
path
          ) (HashMap Path NExprLoc -> m NExprLoc)
-> m (HashMap Path NExprLoc) -> m NExprLoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((HashMap Path NExprLoc, b) -> HashMap Path NExprLoc)
-> m (HashMap Path NExprLoc)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HashMap Path NExprLoc, b) -> HashMap Path NExprLoc
forall a b. (a, b) -> a
fst

defaultPathToDefaultNix :: MonadNix e t f m => Path -> m Path
defaultPathToDefaultNix :: Path -> m Path
defaultPathToDefaultNix = Path -> m Path
forall (m :: * -> *). MonadFile m => Path -> m Path
pathToDefaultNixFile

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

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