chore: introduce newtypes for volume/container/path

Author: pbrisbin

src/Restyler/CodeVolume.hs

@@ -7,42 +7,56 @@
 -- Stability   : experimental
 -- Portability : POSIX
 module Restyler.CodeVolume
-  ( withCodeVolume
+  ( VolumeName (..)
+  , withCodeVolume
   ) where
 
 import Restyler.Prelude
 
 import Restyler.Monad.Docker
 import UnliftIO.Exception (bracket)
 
-withCodeVolume :: (MonadDocker m, MonadUnliftIO m) => (String -> m a) -> m a
-withCodeVolume = bracket acquire dockerVolumeRm
+newtype VolumeName = VolumeName
+  { unwrap :: String
+  }
+
+withCodeVolume :: (MonadDocker m, MonadUnliftIO m) => (VolumeName -> m a) -> m a
+withCodeVolume = bracket acquire (dockerVolumeRm . (.unwrap))
  where
-  acquire :: (MonadDocker m, MonadUnliftIO m) => m String
+  acquire :: (MonadDocker m, MonadUnliftIO m) => m VolumeName
   acquire = withVolumeInContainer tmpVolumeName $ \cName cPath -> do
-    tmpVolumeName <$ dockerCp "." (cName <> ":" <> cPath)
+    tmpVolumeName <$ dockerCp "." (cName.unwrap <> ":" <> cPath.unwrap)
+
+newtype ContainerName = ContainerName
+  { unwrap :: String
+  }
+
+newtype ContainerPath = ContainerPath
+  { unwrap :: FilePath
+  }
 
 withVolumeInContainer
   :: (MonadDocker m, MonadUnliftIO m)
-  => String
-  -> (String -> FilePath -> m a)
+  => VolumeName
+  -> (ContainerName -> ContainerPath -> m a)
   -> m a
-withVolumeInContainer name = bracket acquire (dockerRm . fst) . uncurry
+withVolumeInContainer name =
+  bracket acquire (dockerRm . (.unwrap) . fst) . uncurry
  where
-  acquire :: MonadDocker m => m (String, FilePath)
+  acquire :: MonadDocker m => m (ContainerName, ContainerPath)
   acquire = do
     dockerCreate
-      $ ["--name", tmpContainerName]
-      <> ["--volume", name <> ":" <> tmpContainerPath]
+      $ ["--name", tmpContainerName.unwrap]
+      <> ["--volume", name.unwrap <> ":" <> tmpContainerPath.unwrap]
       <> ["busybox"]
 
     pure (tmpContainerName, tmpContainerPath)
 
-tmpVolumeName :: String
-tmpVolumeName = "restyler-code-volume"
+tmpVolumeName :: VolumeName
+tmpVolumeName = VolumeName "restyler-code-volume"
 
-tmpContainerName :: String
-tmpContainerName = "restyler-tmp-container"
+tmpContainerName :: ContainerName
+tmpContainerName = ContainerName "restyler-tmp-container"
 
-tmpContainerPath :: FilePath
-tmpContainerPath = "/data"
+tmpContainerPath :: ContainerPath
+tmpContainerPath = ContainerPath "/data"

src/Restyler/Restyler/Run.hs

@@ -247,8 +247,7 @@ runRestyler
      , MonadUnliftIO m
      , MonadWriteFile m
      )
-  => String
-  -- ^ Code volume name
+  => VolumeName
   -> Restyler
   -> [FilePath]
   -> m (Maybe RestylerResult)
@@ -279,7 +278,7 @@ runRestyler_
      , MonadUnliftIO m
      , MonadWriteFile m
      )
-  => String
+  => VolumeName
   -> Restyler
   -> [FilePath]
   -> m ()
@@ -367,7 +366,7 @@ dockerRunRestyler
      , MonadUnliftIO m
      , MonadWriteFile m
      )
-  => String
+  => VolumeName
   -> Restyler
   -> WithProgress DockerRunStyle
   -> m ()
@@ -382,7 +381,7 @@ dockerRunRestyler vol r@Restyler {..} WithProgress {..} = do
       restrictionOptions restrictions
         <> ["--name", cName]
         <> ["--pull", "never"]
-        <> ["--volume", vol <> ":/code", rImage]
+        <> ["--volume", vol.unwrap <> ":/code", rImage]
         <> nub (rCommand <> rArguments)
 
     copyRestyledPaths = traverse_ $ \path ->