-- |Types that represent a "slice" of a repository, as defined by a
-- list of DebSource.  This is called a slice because some sections
-- may be omitted, and because different repositories may be combined
-- in the list.
module Debian.Repo.Slice
    ( sourceSlices
    , binarySlices
    , inexactPathSlices
    , releaseSlices
    , appendSliceLists
    , verifySourceLine
    , verifySourcesList
    , repoSources
    , parseNamedSliceList
    , parseNamedSliceList'
    ) where

import Control.Exception (throw)
import Control.Monad.Trans
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List
import Data.Maybe
import Debian.Control
--import Debian.Extra.CIO (vMessage)
import Debian.Repo.IO
import Debian.Repo.LocalRepository
import Debian.Repo.Repository
--import Debian.Shell
import Debian.Repo.SourcesList
import Debian.Repo.Types
import Debian.URI
--import Extra.Net (webServerDirectoryContents)
import Extra.CIO (CIO, vPutStrBl)
--import System.Unix.Process
--import System.Directory
import Text.Regex

sourceSlices :: SliceList -> SliceList
sourceSlices = SliceList . filter ((== DebSrc) . sourceType . sliceSource) . slices

binarySlices :: SliceList -> SliceList
binarySlices = SliceList . filter ((== Deb) . sourceType . sliceSource) . slices

inexactPathSlices :: SliceList -> SliceList
inexactPathSlices = SliceList . filter (either (const False) (const True) . sourceDist . sliceSource) . slices

releaseSlices :: ReleaseName -> SliceList -> SliceList
releaseSlices release list =
    SliceList . filter (isRelease . sourceDist . sliceSource) $ (slices list)
    where isRelease = either (const False) (\ (x, _) -> x == release)

appendSliceLists :: [SliceList] -> SliceList
appendSliceLists lists =
    SliceList { slices = concat (map slices lists) }

-- |Examine the repository whose root is at the given URI and return a
-- set of sources that includes all of its releases.  This is used to
-- ensure that a package we want to upload doesn't already exist in
-- the repository.
repoSources :: CIO m => Maybe EnvRoot -> URI -> AptIOT m SliceList
repoSources chroot uri =
    do lift (vPutStrBl 3 $ "repoSources " ++ uriToString' uri)
       dirs <- lift (uriSubdirs chroot (uri {uriPath = uriPath uri ++ "/dists/"}))
       lift (vPutStrBl 3 $ "  dirs: " ++ show dirs)
       releaseFiles <- mapM (lift . readRelease uri) dirs >>= return . catMaybes
       let codenames = map (maybe Nothing (zap (flip elem dirs))) . map (fieldValue "Codename") $ releaseFiles
       lift (vPutStrBl 3 $ "  codenames: " ++ show (catMaybes codenames))
       let sections = map (maybe Nothing (Just . map parseSection' . splitRegex (mkRegex "[ \t,]+")) . fieldValue "Components") $ releaseFiles
       lift (vPutStrBl 3 $ "  sections: " ++ show (catMaybes codenames))
       let result = concat $ map sources . nubBy (\ (a, _) (b, _) -> a == b) . zip codenames $ sections
       lift (vPutStrBl 2 $ "repoSources " ++ uriToString' uri ++ " ->\n [" ++ unwords (map show result) ++ "]")
       mapM (verifyDebSource Nothing) result >>= (\ list -> return $ SliceList { slices = list })
    where
      sources (Just codename, Just components@(_ : _)) =
          [DebSource {sourceType = Deb, sourceUri = uri, sourceDist = Right (parseReleaseName codename, components)},
           DebSource {sourceType = DebSrc, sourceUri = uri, sourceDist = Right (parseReleaseName codename, components)}]
      sources _ = []
      -- Compute the list of sections for each dist on a remote server.
      zap p x = if p x then Just x else Nothing

-- |Return the list of releases in a repository, which is the
-- list of directories in the dists subdirectory.  Currently
-- this is only known to work with Apache.  Note that some of
-- the returned directories may be symlinks.
uriSubdirs :: CIO m => (Maybe EnvRoot) -> URI -> m [String]
uriSubdirs root uri =
    liftIO (dirFromURI uri') >>= either throw return
    where
      uri' = case uriScheme uri of
               "file:" -> uri {uriPath = maybe "" rootPath root ++ (uriPath uri)}
               _ -> uri

readRelease :: CIO m => URI -> String -> m (Maybe Paragraph)
readRelease uri name =
    do output <- liftIO (fileFromURI uri')
       case output of
         Left e -> throw e
         Right s -> case parseControl (show uri') (L.unpack s) of
                      Right (Control [paragraph]) -> return (Just paragraph)
                      _ -> return Nothing
    where
      uri' = uri {uriPath = uriPath uri ++ "/dists/" ++ name ++ "/Release"}

parseNamedSliceList :: CIO m => String -> AptIOT m (Maybe NamedSliceList)
parseNamedSliceList text =
    case matchRegex re text of
      Just [name, sources] ->
          (verifySourcesList Nothing . parseSourcesList) sources >>=
          \ sources -> return . Just $ NamedSliceList { sliceListName = SliceName name
                                                      , sliceList = sources }
      _ -> return Nothing
    where
      re = mkRegexWithOpts "^[ \t\n]*([^ \t\n]+)[ \t\n]+(.*)$" False True

-- |Create ReleaseCache info from an entry in the config file, which
-- includes a dist name and the lines of the sources.list file.
-- This also creates the basic 
parseNamedSliceList' :: CIO m => String -> AptIOT m NamedSliceList
parseNamedSliceList' text =
    -- FIXME: This regexp is too permissive - it will match almost anything
    case matchRegex re text of
      Just [name, sources] -> 
          do sources <- (verifySourcesList Nothing . parseSourcesList) sources
             return $ NamedSliceList { sliceListName = SliceName name, sliceList = sources }
      _ -> error "Syntax error in sources text"
    where
      re = mkRegexWithOpts "^[ \t\n]*([^ \t\n]+)[ \t\n]+(.*)$" False True

verifySourcesList :: CIO m => Maybe EnvRoot -> [DebSource] -> AptIOT m SliceList
verifySourcesList chroot list =
    mapM (verifyDebSource chroot) list >>=
    (\ list -> return $ SliceList { slices = list })

verifySourceLine :: CIO m => Maybe EnvRoot -> String -> AptIOT m Slice
verifySourceLine chroot str = verifyDebSource chroot (parseSourceLine str)

verifyDebSource :: CIO m => Maybe EnvRoot -> DebSource -> AptIOT m Slice
verifyDebSource chroot line =
    do repo <- case uriScheme uri of
                 "file:" -> 
                     let path = EnvPath (maybe (EnvRoot "") id chroot) (uriPath uri) in
                     prepareLocalRepository path Nothing >>= return . LocalRepo
                 _ ->
                     prepareRepository uri
       return $ Slice { sliceRepo = repo, sliceSource = line }
    where
      uri = sourceUri line