Skip to content

Commit efcce65

Browse files
committed
Fresh{,.Basic}, Effects: m clean-up
1 parent 850f569 commit efcce65

File tree

3 files changed

+33
-29
lines changed

3 files changed

+33
-29
lines changed

src/Nix/Effects.hs

Lines changed: 20 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ import qualified System.Info
4444
import System.Process
4545

4646
import qualified System.Nix.Hash as Store
47-
import qualified System.Nix.Store.Remote as Store
47+
import qualified System.Nix.Store.Remote as Store.Remote
4848
import qualified System.Nix.StorePath as Store
4949

5050
-- | A path into the nix store
@@ -227,11 +227,11 @@ instance MonadHttp IO where
227227

228228

229229
class Monad m => MonadPutStr m where
230-
--TODO: Should this be used *only* when the Nix to be evaluated invokes a
231-
--`trace` operation?
232-
putStr :: String -> m ()
233-
default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m ()
234-
putStr = lift . putStr
230+
--TODO: Should this be used *only* when the Nix to be evaluated invokes a
231+
--`trace` operation?
232+
putStr :: String -> m ()
233+
default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m ()
234+
putStr = lift . putStr
235235

236236
putStrLn :: MonadPutStr m => String -> m ()
237237
putStrLn = putStr . (<> "\n")
@@ -251,20 +251,20 @@ type StorePathSet = HS.HashSet StorePath
251251

252252
class Monad m => MonadStore m where
253253

254-
-- | Copy the contents of a local path to the store. The resulting store
255-
-- path is returned. Note: This does not support yet support the expected
256-
-- `filter` function that allows excluding some files.
257-
addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
258-
default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
259-
addToStore a b c d = lift $ addToStore a b c d
254+
-- | Copy the contents of a local path to the store. The resulting store
255+
-- path is returned. Note: This does not support yet support the expected
256+
-- `filter` function that allows excluding some files.
257+
addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
258+
default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
259+
addToStore a b c d = lift $ addToStore a b c d
260260

261-
-- | Like addToStore, but the contents written to the output path is a
262-
-- regular file containing the given string.
263-
addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
264-
default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
265-
addTextToStore' a b c d = lift $ addTextToStore' a b c d
261+
-- | Like addToStore, but the contents written to the output path is a
262+
-- regular file containing the given string.
263+
addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
264+
default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
265+
addTextToStore' a b c d = lift $ addTextToStore' a b c d
266266

267-
parseStoreResult :: Monad m => String -> (Either String a, [Store.Logger]) -> m (Either ErrorCall a)
267+
parseStoreResult :: Monad m => String -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)
268268
parseStoreResult name res = case res of
269269
(Left msg, logs) -> return $ Left $ ErrorCall $ "Failed to execute '" <> name <> "': " <> msg <> "\n" <> show logs
270270
(Right result, _) -> return $ Right result
@@ -275,13 +275,13 @@ instance MonadStore IO where
275275
Left err -> return $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err
276276
Right pathName -> do
277277
-- TODO: redesign the filter parameter
278-
res <- Store.runStore $ Store.addToStore @'Store.SHA256 pathName path recursive (const False) repair
278+
res <- Store.Remote.runStore $ Store.Remote.addToStore @'Store.SHA256 pathName path recursive (const False) repair
279279
parseStoreResult "addToStore" res >>= \case
280280
Left err -> return $ Left err
281281
Right storePath -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath storePath
282282

283283
addTextToStore' name text references repair = do
284-
res <- Store.runStore $ Store.addTextToStore name text references repair
284+
res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair
285285
parseStoreResult "addTextToStore" res >>= \case
286286
Left err -> return $ Left err
287287
Right path -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath path

src/Nix/Fresh.hs

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -50,14 +50,16 @@ instance MonadTrans (FreshIdT i) where
5050
instance MonadBase b m => MonadBase b (FreshIdT i m) where
5151
liftBase = FreshIdT . liftBase
5252

53-
instance ( MonadVar m
54-
, Eq i
55-
, Ord i
56-
, Show i
57-
, Enum i
58-
, Typeable i
59-
)
60-
=> MonadThunkId (FreshIdT i m) where
53+
instance
54+
( MonadVar m
55+
, Eq i
56+
, Ord i
57+
, Show i
58+
, Enum i
59+
, Typeable i
60+
)
61+
=> MonadThunkId (FreshIdT i m)
62+
where
6163
type ThunkId (FreshIdT i m) = i
6264
freshId = FreshIdT $ do
6365
v <- ask
@@ -69,6 +71,7 @@ runFreshIdT i m = runReaderT (unFreshIdT m) i
6971
-- Orphan instance needed by Infer.hs and Lint.hs
7072

7173
-- Since there's no forking, it's automatically atomic.
74+
-- NOTE: MonadAtomicRef (ST s) can be upstreamed to `ref-tf`
7275
instance MonadAtomicRef (ST s) where
7376
atomicModifyRef r f = do
7477
v <- readRef r

src/Nix/Fresh/Basic.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import Nix.Value
2020

2121
type StdIdT = FreshIdT Int
2222

23+
-- NOTE: These would be removed by: https://github.com/haskell-nix/hnix/pull/804
2324
instance (MonadFail m, MonadFile m) => MonadFile (StdIdT m)
2425
instance MonadIntrospect m => MonadIntrospect (StdIdT m)
2526
instance MonadStore m => MonadStore (StdIdT m)
@@ -45,6 +46,6 @@ instance (MonadEffects t f m, MonadDataContext f m)
4546
pathToDefaultNix = lift . pathToDefaultNix @t @f @m
4647
derivationStrict v = do
4748
i <- FreshIdT ask
48-
p <- lift $ derivationStrict @t @f @m (unliftNValue (runFreshIdT i) v)
49+
p <- lift $ derivationStrict @t @f @m $ unliftNValue (runFreshIdT i) v
4950
return $ liftNValue (runFreshIdT i) p
5051
traceEffect = lift . traceEffect @t @f @m

0 commit comments

Comments
 (0)