dnf-repo-0.7: src/YumRepoFile.hs

{-# LANGUAGE CPP #-}

module YumRepoFile (
  readRepos,
  RepoState(..),
  printRepo,
  applyOverrides,
  readOverrides
  )
where

import Control.Applicative ((<|>))
import Control.Monad (foldM)
import Data.List.Extra (breakOn, isInfixOf, isPrefixOf, splitOn, trim, trimEnd,
#if !MIN_VERSION_base(4,20,0)
                        foldl',
#endif
                        unsnoc)
import Data.Maybe (fromMaybe)
import SimpleCmd (error', warning, (+-+))
import System.FilePath.Glob (compile, match)

data RepoState =
  RepoState
  { repoName :: String
  , repoState :: (Bool, -- enabled
                  FilePath, -- repofile
                  Maybe String -- baseurl
                 )
  }
  deriving (Eq, Ord)

readRepos :: FilePath -> IO [RepoState]
readRepos file =
  parseRepos file . lines <$> readFile file

-- parse ini
parseRepos :: FilePath -> [String] -> [RepoState]
parseRepos file ls =
  case nextSection file ls of
    Nothing -> []
    Just (section,rest) ->
      let (mbaseurl,rest1) =
            case dropWhile (not . ("baseurl" `isInfixOf`)) rest of
              [] -> (Nothing,rest)
              (e:more') ->
                case breakOn "=" e of
                  (_,'=':url) -> (Just (trim url), more')
                  _ -> error' $ "failed to parse" +-+ show e +-+ "for" +-+ section
          (enabled,more) =
            case dropWhile (not . ("enabled" `isPrefixOf`)) rest1 of
              [] -> error' $ "no enabled field for" +-+ section
              (e:more') ->
                case splitOn "=" e of
                  [_,v] ->
                    case trim v of
                      "1" -> (True,more')
                      "0" -> (False,more')
                      _ -> error' $ "strange enabled state" +-+ e +-+ "for" +-+ section
                  _ -> error' $ "unknown enabled state" +-+ e +-+ "for" +-+ section
      in RepoState section (enabled,file,mbaseurl) : parseRepos file more

nextSection :: FilePath -> [String] -> Maybe (String,[String])
nextSection _ [] = Nothing
nextSection file (l:ls') =
  case trimEnd l of
    ('[' : rest) ->
      case unsnoc rest of
        Just (rest',']') -> Just (rest', ls')
        _ ->  error' $ "bad section" +-+ l +-+ "in" +-+ file
    _ -> nextSection file ls'

printRepo :: RepoState -> IO ()
printRepo (RepoState n s) =
  print (n,s)

-- An override section may set only enabled and/or baseurl (or neither).
data RepoOverride = RepoOverride String (Maybe Bool) (Maybe String)

readOverrides :: FilePath -> IO [RepoOverride]
readOverrides file = do
  ls <- lines <$> readFile file
  parseOverrides file ls

parseOverrides :: FilePath -> [String] -> IO [RepoOverride]
parseOverrides file ls =
  case nextSection file ls of
    Nothing -> return []
    Just (section, rest) -> do
      let (body, more) = break isHeader rest
      ov <- sectionOverride file (trim section) body
      (ov :) <$> parseOverrides file more
  where
    isHeader l =
      case trimEnd l of
        '[':_ -> True
        _ -> False

sectionOverride :: FilePath -> String -> [String] -> IO RepoOverride
sectionOverride file section body = do
  (menable, murl) <- foldM add (Nothing, Nothing) body
  return $ RepoOverride section menable murl
  where
    add (menable, murl) line =
      case splitKv line of
        Just ("enabled", v) ->
          case v of
            "1" -> return (Just True, murl)
            "0" -> return (Just False, murl)
            _ -> do
              warning $ "strange enabled state" +-+ v +-+ "for" +-+ section +-+
                "in" +-+ file
              return (menable, murl)
        Just ("baseurl", v) -> return (menable, Just v)
        _ -> return (menable, murl)

    splitKv line =
      case breakOn "=" line of
        (k, '=':v) -> Just (trim k, trim v)
        _ -> Nothing

applyOverrides :: [RepoOverride] -> [RepoState] -> [RepoState]
applyOverrides ovs states = foldl' applyOne states ovs
  where
    applyOne ss (RepoOverride pat men murl) =
      let compiled = compile pat
      in map (apply compiled men murl) ss

    apply compiled men murl rs@(RepoState name (en, file, url))
      | match compiled name =
          RepoState name (fromMaybe en men, file, murl <|> url)
      | otherwise = rs