mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-10-26 21:56:29 +03:00
remote: move StoreMonad to MonadStore
This commit is contained in:
parent
760408093e
commit
64a4368dfd
@ -66,6 +66,7 @@ library
|
||||
, System.Nix.Store.Remote.Serialize
|
||||
, System.Nix.Store.Remote.Serialize.Prim
|
||||
, System.Nix.Store.Remote.Logger
|
||||
, System.Nix.Store.Remote.MonadStore
|
||||
, System.Nix.Store.Remote.Protocol
|
||||
, System.Nix.Store.Remote.Socket
|
||||
, System.Nix.Store.Remote.Types
|
||||
|
@ -28,20 +28,17 @@ module System.Nix.Store.Remote
|
||||
, syncWithGC
|
||||
, verifyStore
|
||||
, module System.Nix.Store.Types
|
||||
, module System.Nix.Store.Remote.MonadStore
|
||||
, module System.Nix.Store.Remote.Types
|
||||
) where
|
||||
|
||||
import Crypto.Hash (SHA256)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Dependent.Sum (DSum((:=>)))
|
||||
import Data.HashSet (HashSet)
|
||||
import Data.Map (Map)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text
|
||||
import qualified Control.Monad
|
||||
import qualified Data.Attoparsec.Text
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified System.Nix.Hash
|
||||
--
|
||||
import System.Nix.Nar (NarSource)
|
||||
import System.Nix.Derivation (Derivation)
|
||||
import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
|
||||
import System.Nix.Build (BuildMode, BuildResult)
|
||||
@ -49,25 +46,28 @@ import System.Nix.Hash (NamedAlgo(..), BaseEncoding(Base16), decodeDigestWith)
|
||||
import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart, InvalidPathError)
|
||||
import System.Nix.StorePath.Metadata (Metadata(..), StorePathTrust(..))
|
||||
|
||||
import qualified Data.Text
|
||||
import qualified Control.Monad
|
||||
import qualified Data.Attoparsec.Text
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified Data.Map.Strict
|
||||
import qualified Data.Serialize.Put
|
||||
import qualified Data.Set
|
||||
|
||||
import qualified System.Nix.ContentAddress
|
||||
import qualified System.Nix.StorePath
|
||||
import qualified System.Nix.Hash
|
||||
import qualified System.Nix.Signature
|
||||
import qualified System.Nix.StorePath
|
||||
|
||||
import System.Nix.Store.Remote.Types
|
||||
import System.Nix.Store.Remote.MonadStore
|
||||
import System.Nix.Store.Remote.Protocol
|
||||
import System.Nix.Store.Remote.Socket
|
||||
import Crypto.Hash (SHA256)
|
||||
import System.Nix.Nar (NarSource)
|
||||
import System.Nix.Store.Remote.Types
|
||||
|
||||
import Data.Serialize (get)
|
||||
import System.Nix.Store.Remote.Serialize
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
|
||||
import qualified Data.Serialize.Put
|
||||
|
||||
-- | Pack `Nar` and add it to the store.
|
||||
addToStore
|
||||
:: forall a
|
||||
|
@ -1,4 +1,3 @@
|
||||
|
||||
module System.Nix.Store.Remote.Logger
|
||||
( Logger(..)
|
||||
, Field(..)
|
||||
@ -10,6 +9,7 @@ import Control.Monad.State.Strict (get)
|
||||
import Data.Serialize.Get (Get, Result(..))
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
import System.Nix.Store.Remote.Socket
|
||||
import System.Nix.Store.Remote.MonadStore
|
||||
import System.Nix.Store.Remote.Types
|
||||
|
||||
import qualified Control.Monad
|
||||
|
62
hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
Normal file
62
hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
Normal file
@ -0,0 +1,62 @@
|
||||
module System.Nix.Store.Remote.MonadStore
|
||||
( MonadStore
|
||||
, mapStoreDir
|
||||
, getStoreDir
|
||||
, getStoreDir'
|
||||
, getLog
|
||||
, flushLog
|
||||
, gotError
|
||||
, getError
|
||||
, setData
|
||||
, clearData
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Control.Monad.Reader (ReaderT, asks)
|
||||
import Control.Monad.Reader.Class (MonadReader)
|
||||
import Control.Monad.State.Strict (StateT, gets, modify)
|
||||
import Data.ByteString (ByteString)
|
||||
|
||||
import Control.Monad.Trans.State.Strict (mapStateT)
|
||||
import Control.Monad.Trans.Except (mapExceptT)
|
||||
import Control.Monad.Trans.Reader (withReaderT)
|
||||
|
||||
import System.Nix.StorePath (HasStoreDir(..), StoreDir)
|
||||
import System.Nix.Store.Remote.Types.Logger (Logger, isError)
|
||||
import System.Nix.Store.Remote.Types.StoreConfig (StoreConfig(..))
|
||||
|
||||
-- | Ask for a @StoreDir@
|
||||
getStoreDir' :: (HasStoreDir r, MonadReader r m) => m StoreDir
|
||||
getStoreDir' = asks hasStoreDir
|
||||
|
||||
type MonadStore a
|
||||
= ExceptT
|
||||
String
|
||||
(StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
|
||||
a
|
||||
|
||||
-- | For lying about the store dir in tests
|
||||
mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
|
||||
mapStoreDir f = mapExceptT . mapStateT . withReaderT
|
||||
$ \c@StoreConfig { storeConfig_dir = sd } -> c { storeConfig_dir = f sd }
|
||||
|
||||
gotError :: MonadStore Bool
|
||||
gotError = gets (any isError . snd)
|
||||
|
||||
getError :: MonadStore [Logger]
|
||||
getError = gets (filter isError . snd)
|
||||
|
||||
getLog :: MonadStore [Logger]
|
||||
getLog = gets snd
|
||||
|
||||
flushLog :: MonadStore ()
|
||||
flushLog = modify (\(a, _b) -> (a, []))
|
||||
|
||||
setData :: ByteString -> MonadStore ()
|
||||
setData x = modify (\(_, b) -> (Just x, b))
|
||||
|
||||
clearData :: MonadStore ()
|
||||
clearData = modify (\(_, b) -> (Nothing, b))
|
||||
|
||||
getStoreDir :: MonadStore StoreDir
|
||||
getStoreDir = asks storeConfig_dir
|
@ -35,6 +35,7 @@ import Network.Socket.ByteString (recv, sendAll)
|
||||
import System.Nix.StorePath (StoreDir(..))
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
import System.Nix.Store.Remote.Logger
|
||||
import System.Nix.Store.Remote.MonadStore
|
||||
import System.Nix.Store.Remote.Socket
|
||||
import System.Nix.Store.Remote.Types hiding (protoVersion)
|
||||
|
||||
|
@ -9,6 +9,7 @@ import Data.Serialize.Get (Get, Result(..))
|
||||
import Data.Serialize.Put
|
||||
import Network.Socket.ByteString (recv, sendAll)
|
||||
import System.Nix.StorePath (StorePath)
|
||||
import System.Nix.Store.Remote.MonadStore
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
import System.Nix.Store.Remote.Types
|
||||
|
||||
|
@ -1,72 +1,15 @@
|
||||
module System.Nix.Store.Remote.Types
|
||||
( MonadStore
|
||||
, StoreConfig(..)
|
||||
, mapStoreDir
|
||||
, getStoreDir
|
||||
, getStoreDir'
|
||||
, getLog
|
||||
, flushLog
|
||||
, gotError
|
||||
, getError
|
||||
, setData
|
||||
, clearData
|
||||
, module System.Nix.Store.Remote.Types.CheckMode
|
||||
( module System.Nix.Store.Remote.Types.CheckMode
|
||||
, module System.Nix.Store.Remote.Types.Logger
|
||||
, module System.Nix.Store.Remote.Types.ProtoVersion
|
||||
, module System.Nix.Store.Remote.Types.StoreConfig
|
||||
, module System.Nix.Store.Remote.Types.SubstituteMode
|
||||
, module System.Nix.Store.Remote.Types.WorkerOp
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (ExceptT)
|
||||
import Control.Monad.Reader (ReaderT, asks)
|
||||
import Control.Monad.Reader.Class (MonadReader)
|
||||
import Control.Monad.State.Strict (StateT, gets, modify)
|
||||
import Data.ByteString (ByteString)
|
||||
|
||||
import Control.Monad.Trans.State.Strict (mapStateT)
|
||||
import Control.Monad.Trans.Except (mapExceptT)
|
||||
import Control.Monad.Trans.Reader (withReaderT)
|
||||
|
||||
import System.Nix.Store.Remote.Types.CheckMode
|
||||
import System.Nix.Store.Remote.Types.Logger
|
||||
import System.Nix.Store.Remote.Types.ProtoVersion
|
||||
import System.Nix.Store.Remote.Types.StoreConfig
|
||||
import System.Nix.Store.Remote.Types.SubstituteMode
|
||||
import System.Nix.Store.Remote.Types.WorkerOp
|
||||
import System.Nix.StorePath (HasStoreDir(..), StoreDir)
|
||||
|
||||
-- | Ask for a @StoreDir@
|
||||
getStoreDir' :: (HasStoreDir r, MonadReader r m) => m StoreDir
|
||||
getStoreDir' = asks hasStoreDir
|
||||
|
||||
type MonadStore a
|
||||
= ExceptT
|
||||
String
|
||||
(StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
|
||||
a
|
||||
|
||||
-- | For lying about the store dir in tests
|
||||
mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
|
||||
mapStoreDir f = mapExceptT . mapStateT . withReaderT
|
||||
$ \c@StoreConfig { storeConfig_dir = sd } -> c { storeConfig_dir = f sd }
|
||||
|
||||
gotError :: MonadStore Bool
|
||||
gotError = gets (any isError . snd)
|
||||
|
||||
getError :: MonadStore [Logger]
|
||||
getError = gets (filter isError . snd)
|
||||
|
||||
getLog :: MonadStore [Logger]
|
||||
getLog = gets snd
|
||||
|
||||
flushLog :: MonadStore ()
|
||||
flushLog = modify (\(a, _b) -> (a, []))
|
||||
|
||||
setData :: ByteString -> MonadStore ()
|
||||
setData x = modify (\(_, b) -> (Just x, b))
|
||||
|
||||
clearData :: MonadStore ()
|
||||
clearData = modify (\(_, b) -> (Nothing, b))
|
||||
|
||||
getStoreDir :: MonadStore StoreDir
|
||||
getStoreDir = asks storeConfig_dir
|
||||
|
Loading…
Reference in New Issue
Block a user