This commit is contained in:
Robert Hensing 2021-05-31 15:17:19 +02:00
parent e73710caf9
commit 2b46a9b5f6

View file

@ -31,7 +31,7 @@ loadImages requestedImages = do
traverse_ loadImage . filter isNew $ requestedImages traverse_ loadImage . filter isNew $ requestedImages
loadImage :: Image -> IO () loadImage :: Image -> IO ()
loadImage (Image { image = Just imgPath, imageName = name }) = loadImage Image { image = Just imgPath, imageName = name } =
withFile (toS imgPath) ReadMode $ \fileHandle -> do withFile (toS imgPath) ReadMode $ \fileHandle -> do
let procSpec = (Process.proc "docker" [ "load" ]) { let procSpec = (Process.proc "docker" [ "load" ]) {
Process.std_in = Process.UseHandle fileHandle Process.std_in = Process.UseHandle fileHandle
@ -43,7 +43,7 @@ loadImage (Image { image = Just imgPath, imageName = name }) =
ExitFailure code -> ExitFailure code ->
panic $ "docker load failed with exit code " <> show code <> " for image " <> name <> " from path " <> imgPath panic $ "docker load failed with exit code " <> show code <> " for image " <> name <> " from path " <> imgPath
loadImage (Image { imageExe = Just imgExe, imageName = name }) = do loadImage Image { imageExe = Just imgExe, imageName = name } = do
let loadSpec = (Process.proc "docker" [ "load" ]) { Process.std_in = Process.CreatePipe } let loadSpec = (Process.proc "docker" [ "load" ]) { Process.std_in = Process.CreatePipe }
Process.withCreateProcess loadSpec $ \(Just inHandle) _out _err loadProcHandle -> do Process.withCreateProcess loadSpec $ \(Just inHandle) _out _err loadProcHandle -> do
let streamSpec = Process.proc (toS imgExe) [] let streamSpec = Process.proc (toS imgExe) []
@ -61,11 +61,11 @@ loadImage (Image { imageExe = Just imgExe, imageName = name }) = do
_ -> pass _ -> pass
pass pass
loadImage (Image { imageName = name }) = do loadImage Image { imageName = name } = do
panic $ "image " <> name <> " doesn't specify an image file or imageExe executable" panic $ "image " <> name <> " doesn't specify an image file or imageExe executable"
getDockerImages :: IO [TaggedImage] getDockerImages :: IO [TaggedImage]
getDockerImages = do getDockerImages = do
let procSpec = Process.proc "docker" [ "images", "--filter", "dangling=false", "--format", "{{.Repository}}:{{.Tag}}" ] let procSpec = Process.proc "docker" [ "images", "--filter", "dangling=false", "--format", "{{.Repository}}:{{.Tag}}" ]
(map toS . T.lines . toS) <$> Process.readCreateProcess procSpec "" map toS . T.lines . toS <$> Process.readCreateProcess procSpec ""