Allow to specify regex for subdir

lib/GHCup/Errors.hs

@@ -89,6 +89,9 @@ data JSONError = JSONDecodeError String
 data FileDoesNotExistError = FileDoesNotExistError ByteString
   deriving Show
 
+data TarDirDoesNotExist = TarDirDoesNotExist TarDir
+  deriving Show
+
 -- | File digest verification failed.
 data DigestError = DigestError Text Text
   deriving Show

lib/GHCup/Types.hs

@@ -137,7 +137,7 @@ data LinuxDistro = Debian
 -- to download, extract and install a tool.
 data DownloadInfo = DownloadInfo
   { _dlUri    :: URI
-  , _dlSubdir :: Maybe (Path Rel)
+  , _dlSubdir :: Maybe TarDir
   , _dlHash   :: Text
   }
   deriving (Eq, Show)
@@ -150,6 +150,12 @@ data DownloadInfo = DownloadInfo
     --------------
 
 
+-- | How to descend into a tar archive.
+data TarDir = RealDir (Path Rel)
+            | RegexDir String     -- ^ will be compiled to regex, the first match will "win"
+            deriving (Eq, Show)
+
+
 -- | Where to fetch GHCupDownloads from.
 data URLSource = GHCupURL
                | OwnSource URI

lib/GHCup/Types/JSON.hs

@@ -193,3 +193,7 @@ instance FromJSON (Path Rel) where
     case parseRel d of
       Right x -> pure x
       Left  e -> fail $ "Failure in HPath Rel (FromJSON)" <> show e
+
+
+deriveJSON defaultOptions{ sumEncoding = ObjectWithSingleField } ''TarDir
+

lib/GHCup/Utils.hs

@@ -48,7 +48,9 @@ import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Data.Either
+import           Data.Foldable
 import           Data.List
+import           Data.List.Split
 import           Data.Maybe
 import           Data.String.Interpolate
 import           Data.Text                      ( Text )
@@ -403,6 +405,28 @@ unpackToDir dest av = do
     | otherwise -> throwE $ UnknownArchive fn
 
 
+intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
+           => Path Abs       -- ^ unpacked tar dir
+           -> TarDir         -- ^ how to descend
+           -> Excepts '[TarDirDoesNotExist] m (Path Abs)
+intoSubdir bdir tardir = case tardir of
+  RealDir pr -> do
+    whenM (fmap not . liftIO . doesDirectoryExist $ (bdir </> pr))
+          (throwE $ TarDirDoesNotExist tardir)
+    pure (bdir </> pr)
+  RegexDir r -> do
+    let rs = splitOn "/" r
+    foldlM
+      (\y x ->
+        (fmap sort . handleIO (\_ -> pure []) . liftIO . findFiles y . regex $ x) >>= \case
+          []      -> throwE $ TarDirDoesNotExist tardir
+          (p : _) -> pure (y </> p)
+      )
+      bdir
+      rs
+    where regex = makeRegexOpts compIgnoreCase execBlank
+
+
 
 
     ------------

lib/GHCup/Utils/Dirs.hs

@@ -166,7 +166,6 @@ ghcupGHCDir :: (MonadReader Settings m, MonadThrow m)
             => GHCTargetVersion
             -> m (Path Abs)
 ghcupGHCDir ver = do
-  Settings {..} <- ask
   ghcbasedir    <- ghcupGHCBaseDir
   verdir        <- parseRel $ E.encodeUtf8 (prettyTVer ver)
   pure (ghcbasedir </> verdir)