mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
squash! hnix-store-remote prototype
use ExceptT, concat logs, utility log functions
This commit is contained in:
parent
a01bff9eb8
commit
b8354d8b42
@ -7,11 +7,13 @@ module System.Nix.Store.Remote.Protocol (
|
||||
, runStore) where
|
||||
|
||||
import Control.Exception (bracket)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
|
||||
import Data.Binary.Get
|
||||
import Data.Binary.Put
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
import Network.Socket hiding (send, sendTo, recv, recvFrom)
|
||||
@ -114,7 +116,9 @@ simpleOpArgs op args = do
|
||||
runOpArgs op args
|
||||
err <- gotError
|
||||
case err of
|
||||
True -> return False -- XXX: ErrorT?
|
||||
True -> do
|
||||
Error _num msg <- head <$> getError
|
||||
throwError $ BSC.unpack $ LBS.toStrict msg
|
||||
False -> do
|
||||
sockGetBool
|
||||
|
||||
@ -128,9 +132,13 @@ runOpArgs op args = do
|
||||
args
|
||||
|
||||
out <- processOutput
|
||||
put out
|
||||
modify (++out)
|
||||
err <- gotError
|
||||
when err $ do
|
||||
Error _num msg <- head <$> getError
|
||||
throwError $ BSC.unpack $ LBS.toStrict msg
|
||||
|
||||
runStore :: MonadStore a -> IO (a, [Logger])
|
||||
runStore :: MonadStore a -> IO (Either String a, [Logger])
|
||||
runStore code = do
|
||||
bracket (open sockPath) close run
|
||||
where
|
||||
@ -152,4 +160,4 @@ runStore code = do
|
||||
processOutput
|
||||
|
||||
run sock =
|
||||
flip runReaderT sock $ flip runStateT [] (greet >> code)
|
||||
flip runReaderT sock $ flip runStateT [] $ runExceptT (greet >> code)
|
||||
|
@ -2,15 +2,19 @@ module System.Nix.Store.Remote.Types (
|
||||
MonadStore
|
||||
, Logger(..)
|
||||
, Field(..)
|
||||
, gotError) where
|
||||
, getLog
|
||||
, flushLog
|
||||
, gotError
|
||||
, getError) where
|
||||
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Network.Socket (Socket)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
|
||||
type MonadStore a = StateT [Logger] (ReaderT Socket IO) a
|
||||
type MonadStore a = ExceptT String (StateT [Logger] (ReaderT Socket IO)) a
|
||||
|
||||
type ActivityID = Int
|
||||
type ActivityParentID = Int
|
||||
@ -38,3 +42,12 @@ isError _ = False
|
||||
|
||||
gotError :: MonadStore Bool
|
||||
gotError = any isError <$> get
|
||||
|
||||
getError :: MonadStore [Logger]
|
||||
getError = filter isError <$> get
|
||||
|
||||
getLog :: MonadStore [Logger]
|
||||
getLog = get
|
||||
|
||||
flushLog :: MonadStore ()
|
||||
flushLog = put []
|
||||
|
Loading…
Reference in New Issue
Block a user