git.iko.soy/docker-hs
on master help sign in
Removes MonadThrow

I've changed my mind about this. I want the functions to be total and return Either DockerError a. After some thinking, I don't think the ExceptT IO antipattern pertains to this case becuase ExceptT isn't exposed to the user rather the user get's Either Error a. The only one who'll see the ExceptT are the libray maintainers. The idea is to catch all the relevant exceptions in the defaultHttpHandler so that the user doesn't have to care that they are dealing with a HTTP Api because that's totally an implementation detail. I realize that I'm sort of going the catch-all/mask-all road here but I will only handle the most common cases to abstract away that we're talking to Docker over a remote http api. I won't mask all, ie. I won't catch SomeException and therefore break async exceptions that way. For 99% of the cases this should be fine but for more advanced users there's always the option of building their own httpHandler to handle whatever special use-case they might have and the functions won't care because they are polymorphic Monad wise.

commit870a4f4e73573d9f073a915cb20592f4a823a225 authorDeni Bertovic <deni@denibertovic.com> dateFri 8 Apr 2016, 15:03 (11 years ago) parentbe93c8d
2 files changed+28−29
compare with master
unifiedsplit
src/Docker.hs+25−26 src/Docker/Types.hs+3−3
src/Docker.hs+25−26
@@ -1,4 +1,5 @@
1−{-# LANGUAGE ExplicitForAll #-}
1+{-# LANGUAGE ExplicitForAll #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23
34module Docker where
45
@@ -16,86 +17,84 @@ import Network.HTTP.Types (StdMethod (..))
1617import Docker.Internal
1718import Docker.Types
1819
19−getDockerVersion :: forall m. MonadThrow m => DockerT m DockerVersion
20+getDockerVersion :: forall m. Monad m => DockerT m DockerVersion
2021getDockerVersion = do
2122 (opts, httpHandler) <- ask
2223 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
23− response <- lift $ ((httpHandler request) :: m Response)
24+ response <- lift . lift $ ((httpHandler request) :: m Response)
2425 let body = responseBody response
2526 let res = decode body
2627 return $ fromJust res
2728
28−listContainers :: forall m. MonadThrow m => ListOpts -> DockerT m [Container]
29+listContainers :: forall m. Monad m => ListOpts -> DockerT m [Container]
2930listContainers lopts = do
3031 (opts, httpHandler) <- ask
3132 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
32− response <- lift $ httpHandler request
33+ response <- lift . lift $ ((httpHandler request) :: m Response)
3334 let body = responseBody response
3435 let res = decode body
3536 return $ fromJust res
3637
37−listImages :: forall m. MonadThrow m => ListOpts -> DockerT m [Image]
38+listImages :: forall m. Monad m => ListOpts -> DockerT m [Image]
3839listImages lopts = do
3940 (opts, httpHandler) <- ask
4041 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
41− response <- lift $ ((httpHandler request) :: m Response)
42+ response <- lift . lift $ ((httpHandler request) :: m Response)
4243 let body = responseBody response
4344 let res = decode body
4445 return $ fromJust res
4546
46−createContainer :: forall m. MonadThrow m => CreateOpts -> DockerT m ContainerID
47+createContainer :: forall m. Monad m => CreateOpts -> DockerT m ContainerID
4748createContainer = undefined
4849
49−startContainer :: forall m. MonadThrow m => StartOpts -> ContainerID -> DockerT m ContainerID
50+startContainer :: forall m. Monad m => StartOpts -> ContainerID -> DockerT m ContainerID
5051startContainer sopts cid = do
5152 (opts, httpHandler) <- ask
5253 let request = fromJust $ mkHttpRequest POST (StartContainerEndpoint sopts cid) opts
53− _ <- lift $ ((httpHandler request) :: m Response)
54+ _ <- lift . lift $ ((httpHandler request) :: m Response)
5455 return cid
5556
56−stopContainer :: forall m. MonadThrow m => Timeout -> ContainerID ->DockerT m ContainerID
57+stopContainer :: forall m. Monad m => Timeout -> ContainerID ->DockerT m ContainerID
5758stopContainer t cid = do
5859 (opts, httpHandler) <- ask
5960 let request = fromJust $ mkHttpRequest POST (StopContainerEndpoint t cid) opts
60− _ <- lift $ ((httpHandler request) :: m Response)
61+ _ <- lift . lift $ ((httpHandler request) :: m Response)
6162 return cid
6263
63−killContainer :: forall m. MonadThrow m => Signal -> ContainerID -> DockerT m ContainerID
64+killContainer :: forall m. Monad m => Signal -> ContainerID -> DockerT m ContainerID
6465killContainer s cid = do
6566 (opts, httpHandler) <- ask
6667 let request = fromJust $ mkHttpRequest POST (KillContainerEndpoint s cid) opts
67− _ <- lift $ ((httpHandler request) :: m Response)
68+ _ <- lift . lift $ ((httpHandler request) :: m Response)
6869 return cid
6970
70−restartContainer :: forall m. MonadThrow m => Timeout -> ContainerID -> DockerT m ContainerID
71+restartContainer :: forall m. Monad m => Timeout -> ContainerID -> DockerT m ContainerID
7172restartContainer t cid = do
7273 (opts, httpHandler) <- ask
7374 let request = fromJust $ mkHttpRequest POST (RestartContainerEndpoint t cid) opts
74− _ <- lift $ ((httpHandler request) :: m Response)
75+ _ <- lift . lift $ ((httpHandler request) :: m Response)
7576 return cid
7677
77−pauseContainer :: forall m. MonadThrow m => ContainerID -> DockerT m ContainerID
78+pauseContainer :: forall m. Monad m => ContainerID -> DockerT m ContainerID
7879pauseContainer cid = do
7980 (opts, httpHandler) <- ask
8081 let request = fromJust $ mkHttpRequest POST (PauseContainerEndpoint cid) opts
81− _ <- lift $ ((httpHandler request) :: m Response)
82+ _ <- lift . lift $ ((httpHandler request) :: m Response)
8283 return cid
8384
84−unpauseContainer :: forall m. MonadThrow m => ContainerID -> DockerT m ContainerID
85+unpauseContainer :: forall m. Monad m => ContainerID -> DockerT m ContainerID
8586unpauseContainer cid = do
8687 (opts, httpHandler) <- ask
8788 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
88− _ <- lift $ ((httpHandler request) :: m Response)
89+ _ <- lift . lift $ ((httpHandler request) :: m Response)
8990 return cid
9091
91−deleteContainer :: forall m. MonadThrow m => DeleteOpts -> ContainerID -> DockerT m ContainerID
92+deleteContainer :: forall m. Monad m => DeleteOpts -> ContainerID -> DockerT m ContainerID
9293deleteContainer dopts cid = do
9394 (opts, httpHandler) <- ask
9495 let request = fromJust $ mkHttpRequest DELETE (DeleteContainerEndpoint dopts cid) opts
95− _ <- lift $ ((httpHandler request) :: m Response)
96+ _ <- lift . lift $ ((httpHandler request) :: m Response)
9697 return cid
9798
98−getContainerLogs :: forall m. MonadThrow m => LogOpts -> ContainerID -> DockerT m ()
99−getContainerLogs logopts cid = undefined
100−
101−
99+getContainerLogs :: forall m. Monad m => LogOpts -> ContainerID -> DockerT m ()
100+getContainerLogs logopts cid = undefined
src/Docker/Types.hs+3−3
@@ -62,10 +62,10 @@ data DockerClientOpts = DockerClientOpts {
6262
6363type HttpHandler m = Request -> m Response
6464
65−type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) m a
65+type DockerT m a = ReaderT (DockerClientOpts, HttpHandler m) (ExceptT String m) a
6666
67−runDockerT :: (MonadThrow m) => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m a
68−runDockerT (opts, h) r = runReaderT r (opts, h)
67+runDockerT :: Monad m => (DockerClientOpts, HttpHandler m) -> DockerT m a -> m (Either String a)
68+runDockerT (opts, h) r = runExceptT $ runReaderT r (opts, h)
6969
7070data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
7171