{-# LANGUAGE PackageImports, ScopedTypeVariables, TupleSections #-} {-# OPTIONS -fno-warn-name-shadowing #-} module Debian.Repo.Package.Internal.IndexPrefix ( indexPrefix ) where import Data.List as List (intercalate) import Debian.Release (releaseName', sectionName') import Debian.Repo.Package.Internal.OtherSymbols ((+?+)) import Debian.Repo.Package.Internal.UriToString (uriToString') import Debian.Repo.Types.PackageIndex (PackageIndex(packageIndexComponent)) import Debian.Repo.Types.Release (Release(releaseName)) import Debian.Repo.Types.Repo (RepoKey, repoKeyURI) import Network.URI (escapeURIString, URI(uriAuthority, uriPath, uriScheme), URIAuth(uriPort, uriRegName, uriUserInfo)) indexPrefix :: RepoKey -> Release -> PackageIndex -> FilePath indexPrefix repo release index = (escapeURIString (/= '@') ("/var/lib/apt/lists/" ++ uriText +?+ "dists_") ++ releaseName' distro ++ "_" ++ (sectionName' $ section)) where section = packageIndexComponent index uri = repoKeyURI repo distro = releaseName $ release scheme = uriScheme uri auth = uriAuthority uri path = uriPath uri userpass = maybe "" uriUserInfo auth reg = maybeOfString $ maybe "" uriRegName auth port = maybe "" uriPort auth (user, pass) = break (== ':') userpass user' = maybeOfString user pass' = maybeOfString pass uriText = prefix scheme user' pass' reg port path -- If user is given and password is not, the user name is -- added to the file name. Otherwise it is not. Really. prefix "http:" (Just user) Nothing (Just host) port path = user ++ host ++ port ++ escape path prefix "http:" _ _ (Just host) port path = host ++ port ++ escape path prefix "ftp:" _ _ (Just host) _ path = host ++ escape path prefix "file:" Nothing Nothing Nothing "" path = escape path prefix "ssh:" (Just user) Nothing (Just host) port path = user ++ host ++ port ++ escape path prefix "ssh" _ _ (Just host) port path = host ++ port ++ escape path prefix _ _ _ _ _ _ = error ("invalid repo URI: " ++ (uriToString' . repoKeyURI $ repo)) maybeOfString "" = Nothing maybeOfString s = Just s escape s = intercalate "_" (wordsBy (== '/') s) wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]] wordsBy p s = case (break p s) of (s, []) -> [s] (h, t) -> h : wordsBy p (drop 1 t)