From efcce65568c11664de37d589b14592fc93c93d2c Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Tue, 9 Feb 2021 01:09:01 +0200 Subject: [PATCH] Fresh{,.Basic}, Effects: m clean-up --- src/Nix/Effects.hs | 40 ++++++++++++++++++++-------------------- src/Nix/Fresh.hs | 19 +++++++++++-------- src/Nix/Fresh/Basic.hs | 3 ++- 3 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs index 024205a3e..e40778f38 100644 --- a/src/Nix/Effects.hs +++ b/src/Nix/Effects.hs @@ -44,7 +44,7 @@ import qualified System.Info import System.Process import qualified System.Nix.Hash as Store -import qualified System.Nix.Store.Remote as Store +import qualified System.Nix.Store.Remote as Store.Remote import qualified System.Nix.StorePath as Store -- | A path into the nix store @@ -227,11 +227,11 @@ instance MonadHttp IO where class Monad m => MonadPutStr m where - --TODO: Should this be used *only* when the Nix to be evaluated invokes a - --`trace` operation? - putStr :: String -> m () - default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m () - putStr = lift . putStr + --TODO: Should this be used *only* when the Nix to be evaluated invokes a + --`trace` operation? + putStr :: String -> m () + default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m () + putStr = lift . putStr putStrLn :: MonadPutStr m => String -> m () putStrLn = putStr . (<> "\n") @@ -251,20 +251,20 @@ type StorePathSet = HS.HashSet StorePath class Monad m => MonadStore m where - -- | Copy the contents of a local path to the store. The resulting store - -- path is returned. Note: This does not support yet support the expected - -- `filter` function that allows excluding some files. - addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) - default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) - addToStore a b c d = lift $ addToStore a b c d + -- | Copy the contents of a local path to the store. The resulting store + -- path is returned. Note: This does not support yet support the expected + -- `filter` function that allows excluding some files. + addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) + default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) + addToStore a b c d = lift $ addToStore a b c d - -- | Like addToStore, but the contents written to the output path is a - -- regular file containing the given string. - addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) - default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) - addTextToStore' a b c d = lift $ addTextToStore' a b c d + -- | Like addToStore, but the contents written to the output path is a + -- regular file containing the given string. + addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) + default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) + addTextToStore' a b c d = lift $ addTextToStore' a b c d -parseStoreResult :: Monad m => String -> (Either String a, [Store.Logger]) -> m (Either ErrorCall a) +parseStoreResult :: Monad m => String -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a) parseStoreResult name res = case res of (Left msg, logs) -> return $ Left $ ErrorCall $ "Failed to execute '" <> name <> "': " <> msg <> "\n" <> show logs (Right result, _) -> return $ Right result @@ -275,13 +275,13 @@ instance MonadStore IO where Left err -> return $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err Right pathName -> do -- TODO: redesign the filter parameter - res <- Store.runStore $ Store.addToStore @'Store.SHA256 pathName path recursive (const False) repair + res <- Store.Remote.runStore $ Store.Remote.addToStore @'Store.SHA256 pathName path recursive (const False) repair parseStoreResult "addToStore" res >>= \case Left err -> return $ Left err Right storePath -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath storePath addTextToStore' name text references repair = do - res <- Store.runStore $ Store.addTextToStore name text references repair + res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair parseStoreResult "addTextToStore" res >>= \case Left err -> return $ Left err Right path -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath path diff --git a/src/Nix/Fresh.hs b/src/Nix/Fresh.hs index ed5793555..8dbd4ae78 100644 --- a/src/Nix/Fresh.hs +++ b/src/Nix/Fresh.hs @@ -50,14 +50,16 @@ instance MonadTrans (FreshIdT i) where instance MonadBase b m => MonadBase b (FreshIdT i m) where liftBase = FreshIdT . liftBase -instance ( MonadVar m - , Eq i - , Ord i - , Show i - , Enum i - , Typeable i - ) - => MonadThunkId (FreshIdT i m) where +instance + ( MonadVar m + , Eq i + , Ord i + , Show i + , Enum i + , Typeable i + ) + => MonadThunkId (FreshIdT i m) + where type ThunkId (FreshIdT i m) = i freshId = FreshIdT $ do v <- ask @@ -69,6 +71,7 @@ runFreshIdT i m = runReaderT (unFreshIdT m) i -- Orphan instance needed by Infer.hs and Lint.hs -- Since there's no forking, it's automatically atomic. +-- NOTE: MonadAtomicRef (ST s) can be upstreamed to `ref-tf` instance MonadAtomicRef (ST s) where atomicModifyRef r f = do v <- readRef r diff --git a/src/Nix/Fresh/Basic.hs b/src/Nix/Fresh/Basic.hs index be5c20972..6c58538bb 100644 --- a/src/Nix/Fresh/Basic.hs +++ b/src/Nix/Fresh/Basic.hs @@ -20,6 +20,7 @@ import Nix.Value type StdIdT = FreshIdT Int +-- NOTE: These would be removed by: https://github.com/haskell-nix/hnix/pull/804 instance (MonadFail m, MonadFile m) => MonadFile (StdIdT m) instance MonadIntrospect m => MonadIntrospect (StdIdT m) instance MonadStore m => MonadStore (StdIdT m) @@ -45,6 +46,6 @@ instance (MonadEffects t f m, MonadDataContext f m) pathToDefaultNix = lift . pathToDefaultNix @t @f @m derivationStrict v = do i <- FreshIdT ask - p <- lift $ derivationStrict @t @f @m (unliftNValue (runFreshIdT i) v) + p <- lift $ derivationStrict @t @f @m $ unliftNValue (runFreshIdT i) v return $ liftNValue (runFreshIdT i) p traceEffect = lift . traceEffect @t @f @m