{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
-- | Access to things that Debian policy says should be in a valid
-- control file.  The pure functions will not throw ControlFileError
-- if they are operating on a DebianControl value returned by
-- validateDebianControl.  However, they might if they are created
-- using unsafeDebianControl.
module Debian.Control.Policy
    ( -- * Validated debian control file type
      DebianControl(unDebianControl)
    , validateDebianControl
    , unsafeDebianControl
    , parseDebianControlFromFile
    , parseDebianControl
    , ControlFileError(..)
    -- * Class of things that contain one DebianControl value
    , HasDebianControl(debianControl)
    -- * Pure functions that operate on validated control files
    , debianSourceParagraph
    , debianBinaryParagraphs
    , debianPackageParagraphs
    , debianPackageNames
    , debianSourcePackageName
    , debianBinaryPackageNames
    , debianRelations
    , debianBuildDeps
    , debianBuildDepsIndep
    ) where

import Control.Exception (Exception, throw)
import Control.Monad.Catch (MonadCatch, try)
import Data.List (intercalate)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.ListLike (toList)
import Debian.Control.Common (Control'(..), Paragraph'(..), Field'(..), fieldValue, ControlFunctions(parseControlFromFile, parseControl))
import Debian.Control.Text ()
import Debian.Loc (__LOC__)
import Debian.Pretty (prettyShow)
import Debian.Relation (SrcPkgName(..), BinPkgName(..), Relations, parseRelations)
import Debian.Relation.Text ()
import Language.Haskell.TH (Loc(..))
import Prelude hiding (ioError)
-- import qualified Debug.ShowPlease as Please
import Text.Parsec.Error (ParseError)

-- | Opaque (constructor not exported) type to hold a validated Debian
-- Control File
data DebianControl = DebianControl {DebianControl -> Control' Text
unDebianControl :: Control' Text}

instance Show DebianControl where
    show :: DebianControl -> String
show DebianControl
c = String
"(parseDebianControl \"\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Control' Text -> String
forall a. Pretty a => a -> String
prettyShow (DebianControl -> Control' Text
unDebianControl DebianControl
c)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Validate and return a control file in an opaque wrapper.  May
-- throw a ControlFileError.  Currently we only verify that it has a
-- Source field in the first paragraph and one or more subsequent
-- paragraphs each with a Package field, and no syntax errors in the
-- build dependencies (though they may be absent.)
validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl :: Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl Control' Text
ctl =
    m () -> m (Either ControlFileError ())
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (do (SrcPkgName, [BinPkgName])
_ <- (SrcPkgName, [BinPkgName]) -> m (SrcPkgName, [BinPkgName])
forall (m :: * -> *) a. Monad m => a -> m a
return ((SrcPkgName, [BinPkgName]) -> m (SrcPkgName, [BinPkgName]))
-> (SrcPkgName, [BinPkgName]) -> m (SrcPkgName, [BinPkgName])
forall a b. (a -> b) -> a -> b
$ DebianControl -> (SrcPkgName, [BinPkgName])
forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
            Maybe Relations
_ <- Maybe Relations -> m (Maybe Relations)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Relations -> m (Maybe Relations))
-> Maybe Relations -> m (Maybe Relations)
forall a b. (a -> b) -> a -> b
$ DebianControl -> Maybe Relations
forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
            Maybe Relations
_ <- Maybe Relations -> m (Maybe Relations)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Relations -> m (Maybe Relations))
-> Maybe Relations -> m (Maybe Relations)
forall a b. (a -> b) -> a -> b
$ DebianControl -> Maybe Relations
forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
            () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m (Either ControlFileError ())
-> (Either ControlFileError ()
    -> m (Either ControlFileError DebianControl))
-> m (Either ControlFileError DebianControl)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    Either ControlFileError DebianControl
-> m (Either ControlFileError DebianControl)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ControlFileError DebianControl
 -> m (Either ControlFileError DebianControl))
-> (Either ControlFileError ()
    -> Either ControlFileError DebianControl)
-> Either ControlFileError ()
-> m (Either ControlFileError DebianControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlFileError -> Either ControlFileError DebianControl)
-> (() -> Either ControlFileError DebianControl)
-> Either ControlFileError ()
-> Either ControlFileError DebianControl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ControlFileError -> Either ControlFileError DebianControl
forall a b. a -> Either a b
Left (\ ()
_ -> DebianControl -> Either ControlFileError DebianControl
forall a b. b -> Either a b
Right (DebianControl -> Either ControlFileError DebianControl)
-> DebianControl -> Either ControlFileError DebianControl
forall a b. (a -> b) -> a -> b
$ Control' Text -> DebianControl
DebianControl Control' Text
ctl)

unsafeDebianControl :: Control' Text -> DebianControl
unsafeDebianControl :: Control' Text -> DebianControl
unsafeDebianControl = Control' Text -> DebianControl
DebianControl

parseDebianControl :: MonadCatch m => String -> Text -> m (Either ControlFileError DebianControl)
parseDebianControl :: String -> Text -> m (Either ControlFileError DebianControl)
parseDebianControl String
sourceName Text
s = (ParseError -> m (Either ControlFileError DebianControl))
-> (Control' Text -> m (Either ControlFileError DebianControl))
-> Either ParseError (Control' Text)
-> m (Either ControlFileError DebianControl)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ControlFileError DebianControl
-> m (Either ControlFileError DebianControl)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ControlFileError DebianControl
 -> m (Either ControlFileError DebianControl))
-> (ParseError -> Either ControlFileError DebianControl)
-> ParseError
-> m (Either ControlFileError DebianControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlFileError -> Either ControlFileError DebianControl
forall a b. a -> Either a b
Left (ControlFileError -> Either ControlFileError DebianControl)
-> (ParseError -> ControlFileError)
-> ParseError
-> Either ControlFileError DebianControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseControlError [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__]) Control' Text -> m (Either ControlFileError DebianControl)
forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl (String -> Text -> Either ParseError (Control' Text)
forall a.
ControlFunctions a =>
String -> a -> Either ParseError (Control' a)
parseControl String
sourceName Text
s)

parseDebianControlFromFile :: FilePath -> IO (Either ControlFileError DebianControl)
parseDebianControlFromFile :: String -> IO (Either ControlFileError DebianControl)
parseDebianControlFromFile String
controlPath =
  IO (Either ParseError (Control' Text))
-> IO (Either IOError (Either ParseError (Control' Text)))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (String -> IO (Either ParseError (Control' Text))
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
controlPath) IO (Either IOError (Either ParseError (Control' Text)))
-> (Either IOError (Either ParseError (Control' Text))
    -> IO (Either ControlFileError DebianControl))
-> IO (Either ControlFileError DebianControl)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (IOError -> IO (Either ControlFileError DebianControl))
-> (Either ParseError (Control' Text)
    -> IO (Either ControlFileError DebianControl))
-> Either IOError (Either ParseError (Control' Text))
-> IO (Either ControlFileError DebianControl)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ControlFileError DebianControl
-> IO (Either ControlFileError DebianControl)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ControlFileError DebianControl
 -> IO (Either ControlFileError DebianControl))
-> (IOError -> Either ControlFileError DebianControl)
-> IOError
-> IO (Either ControlFileError DebianControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlFileError -> Either ControlFileError DebianControl
forall a b. a -> Either a b
Left (ControlFileError -> Either ControlFileError DebianControl)
-> (IOError -> ControlFileError)
-> IOError
-> Either ControlFileError DebianControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> IOError -> ControlFileError
IOError [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__])
         ((ParseError -> IO (Either ControlFileError DebianControl))
-> (Control' Text -> IO (Either ControlFileError DebianControl))
-> Either ParseError (Control' Text)
-> IO (Either ControlFileError DebianControl)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either ControlFileError DebianControl
-> IO (Either ControlFileError DebianControl)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ControlFileError DebianControl
 -> IO (Either ControlFileError DebianControl))
-> (ParseError -> Either ControlFileError DebianControl)
-> ParseError
-> IO (Either ControlFileError DebianControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlFileError -> Either ControlFileError DebianControl
forall a b. a -> Either a b
Left (ControlFileError -> Either ControlFileError DebianControl)
-> (ParseError -> ControlFileError)
-> ParseError
-> Either ControlFileError DebianControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseControlError [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__]) Control' Text -> IO (Either ControlFileError DebianControl)
forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl)

-- | Class of things that contain a validated Debian control file.
class Show a => HasDebianControl a where
    debianControl :: a -> DebianControl

instance HasDebianControl DebianControl where
    debianControl :: DebianControl -> DebianControl
debianControl = DebianControl -> DebianControl
forall a. a -> a
id

class HasControl a where
    control :: a -> Control' Text

instance HasControl (Control' Text) where
    control :: Control' Text -> Control' Text
control = Control' Text -> Control' Text
forall a. a -> a
id

instance HasControl DebianControl where
    control :: DebianControl -> Control' Text
control = DebianControl -> Control' Text
unDebianControl

-- | Errors that control files might throw, with source file name and
-- line number generated by template haskell.
data ControlFileError
    = NoParagraphs        {ControlFileError -> [Loc]
locs :: [Loc]}
    | NoBinaryParagraphs  {locs :: [Loc], ControlFileError -> String
ctl :: String}
    | MissingField        {locs :: [Loc], ControlFileError -> String
field :: String}
    | ParseRelationsError {locs :: [Loc], ControlFileError -> ParseError
parseError :: ParseError}
    | ParseControlError   {locs :: [Loc], parseError :: ParseError}
    | IOError             {locs :: [Loc], ControlFileError -> IOError
ioError :: IOError}
    deriving Typeable

instance Show ControlFileError where
    show :: ControlFileError -> String
show (NoParagraphs {[Loc]
locs :: [Loc]
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": NoParagraphs"
    show (NoBinaryParagraphs {String
[Loc]
ctl :: String
locs :: [Loc]
ctl :: ControlFileError -> String
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": NoBinaryParagraphs"
    show (MissingField {String
[Loc]
field :: String
locs :: [Loc]
field :: ControlFileError -> String
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": MissingField " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
field
    show (ParseRelationsError {[Loc]
ParseError
parseError :: ParseError
locs :: [Loc]
parseError :: ControlFileError -> ParseError
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ParseRelationsError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
parseError
    show (ParseControlError {[Loc]
ParseError
parseError :: ParseError
locs :: [Loc]
parseError :: ControlFileError -> ParseError
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ParseControlError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
parseError
    show (IOError {[Loc]
IOError
ioError :: IOError
locs :: [Loc]
ioError :: ControlFileError -> IOError
locs :: ControlFileError -> [Loc]
..}) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Loc -> String) -> [Loc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": IOError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
ioError

showLoc :: Loc -> String
showLoc :: Loc -> String
showLoc Loc
x = ShowS
forall a. Show a => a -> String
show (Loc -> String
loc_filename Loc
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (CharPos -> Int
forall a b. (a, b) -> a
fst (Loc -> CharPos
loc_start Loc
x)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (CharPos -> Int
forall a b. (a, b) -> b
snd (Loc -> CharPos
loc_start Loc
x)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

-- instance Please.Show ControlFileError where
--     show (IOError e) = "(IOError " ++ Please.show e ++ ")"
--     show (ParseRelationsError e) = "(ParseRelationsError " ++ Please.show e ++ ")"
--     show (ParseControlError e) = "(ParseControlError " ++ Please.show e ++ ")"
--     show x = show x

instance Exception ControlFileError

instance Eq ControlFileError where
    ControlFileError
_ == :: ControlFileError -> ControlFileError -> Bool
== ControlFileError
_ = Bool
False

debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs :: a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs a
ctl =
    case a -> DebianControl
forall a. HasDebianControl a => a -> DebianControl
removeCommentParagraphs a
ctl of
      DebianControl (Control [Paragraph' Text
_]) -> ControlFileError -> (Paragraph' Text, [Paragraph' Text])
forall a e. Exception e => e -> a
throw (ControlFileError -> (Paragraph' Text, [Paragraph' Text]))
-> ControlFileError -> (Paragraph' Text, [Paragraph' Text])
forall a b. (a -> b) -> a -> b
$ [Loc] -> String -> ControlFileError
NoBinaryParagraphs [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__] (a -> String
forall a. Show a => a -> String
show a
ctl)
      DebianControl (Control []) -> ControlFileError -> (Paragraph' Text, [Paragraph' Text])
forall a e. Exception e => e -> a
throw (ControlFileError -> (Paragraph' Text, [Paragraph' Text]))
-> ControlFileError -> (Paragraph' Text, [Paragraph' Text])
forall a b. (a -> b) -> a -> b
$ [Loc] -> ControlFileError
NoParagraphs [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__]
      DebianControl (Control (Paragraph' Text
sourceParagraph : [Paragraph' Text]
binParagraphs)) -> (Paragraph' Text
sourceParagraph, [Paragraph' Text]
binParagraphs)

-- | Comment paragraphs are rare, but they happen.
removeCommentParagraphs :: HasDebianControl a => a -> DebianControl
removeCommentParagraphs :: a -> DebianControl
removeCommentParagraphs a
c =
    Control' Text -> DebianControl
DebianControl ([Paragraph' Text] -> Control' Text
forall a. [Paragraph' a] -> Control' a
Control ((Paragraph' Text -> Bool) -> [Paragraph' Text] -> [Paragraph' Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Paragraph' Text -> Bool) -> Paragraph' Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph' Text -> Bool
forall a. Paragraph' a -> Bool
isCommentParagraph) (Control' Text -> [Paragraph' Text]
forall a. Control' a -> [Paragraph' a]
unControl (DebianControl -> Control' Text
unDebianControl (a -> DebianControl
forall a. HasDebianControl a => a -> DebianControl
debianControl a
c)))))
    where
      isCommentParagraph :: Paragraph' a -> Bool
isCommentParagraph (Paragraph [Field' a]
fields) = (Field' a -> Bool) -> [Field' a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Field' a -> Bool
forall a. Field' a -> Bool
isCommentField [Field' a]
fields
      isCommentField :: Field' a -> Bool
isCommentField (Comment a
_) = Bool
True
      isCommentField Field' a
_ = Bool
False

debianSourceParagraph :: HasDebianControl a => a -> Paragraph' Text
debianSourceParagraph :: a -> Paragraph' Text
debianSourceParagraph = (Paragraph' Text, [Paragraph' Text]) -> Paragraph' Text
forall a b. (a, b) -> a
fst ((Paragraph' Text, [Paragraph' Text]) -> Paragraph' Text)
-> (a -> (Paragraph' Text, [Paragraph' Text]))
-> a
-> Paragraph' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Paragraph' Text, [Paragraph' Text])
forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs

debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]
debianBinaryParagraphs :: a -> [Paragraph' Text]
debianBinaryParagraphs = (Paragraph' Text, [Paragraph' Text]) -> [Paragraph' Text]
forall a b. (a, b) -> b
snd ((Paragraph' Text, [Paragraph' Text]) -> [Paragraph' Text])
-> (a -> (Paragraph' Text, [Paragraph' Text]))
-> a
-> [Paragraph' Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Paragraph' Text, [Paragraph' Text])
forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs

debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames :: a -> (SrcPkgName, [BinPkgName])
debianPackageNames a
c =
  let (Paragraph' Text
srcParagraph, [Paragraph' Text]
binParagraphs) = a -> (Paragraph' Text, [Paragraph' Text])
forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs a
c in
  ((Text -> SrcPkgName) -> String -> Paragraph' Text -> SrcPkgName
forall a. (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue (String -> SrcPkgName
SrcPkgName (String -> SrcPkgName) -> (Text -> String) -> Text -> SrcPkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall l. IsList l => l -> [Item l]
toList) String
"Source" Paragraph' Text
srcParagraph, (Paragraph' Text -> BinPkgName)
-> [Paragraph' Text] -> [BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> BinPkgName) -> String -> Paragraph' Text -> BinPkgName
forall a. (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue (String -> BinPkgName
BinPkgName (String -> BinPkgName) -> (Text -> String) -> Text -> BinPkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall l. IsList l => l -> [Item l]
toList) String
"Package") [Paragraph' Text]
binParagraphs)

debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName
debianSourcePackageName :: a -> SrcPkgName
debianSourcePackageName = (SrcPkgName, [BinPkgName]) -> SrcPkgName
forall a b. (a, b) -> a
fst ((SrcPkgName, [BinPkgName]) -> SrcPkgName)
-> (a -> (SrcPkgName, [BinPkgName])) -> a -> SrcPkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (SrcPkgName, [BinPkgName])
forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames

debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames :: a -> [BinPkgName]
debianBinaryPackageNames = (SrcPkgName, [BinPkgName]) -> [BinPkgName]
forall a b. (a, b) -> b
snd ((SrcPkgName, [BinPkgName]) -> [BinPkgName])
-> (a -> (SrcPkgName, [BinPkgName])) -> a -> [BinPkgName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (SrcPkgName, [BinPkgName])
forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames

debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep :: a -> Maybe Relations
debianBuildDepsIndep a
ctl = (ControlFileError -> Maybe Relations)
-> (Maybe Relations -> Maybe Relations)
-> Either ControlFileError (Maybe Relations)
-> Maybe Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ControlFileError -> Maybe Relations
forall a e. Exception e => e -> a
throw Maybe Relations -> Maybe Relations
forall a. a -> a
id (Either ControlFileError (Maybe Relations) -> Maybe Relations)
-> Either ControlFileError (Maybe Relations) -> Maybe Relations
forall a b. (a -> b) -> a -> b
$ String
-> DebianControl -> Either ControlFileError (Maybe Relations)
forall a.
HasDebianControl a =>
String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
"Build-Depends-Indep" (a -> DebianControl
forall a. HasDebianControl a => a -> DebianControl
debianControl a
ctl)

debianBuildDeps :: HasDebianControl a => a -> Maybe Relations
debianBuildDeps :: a -> Maybe Relations
debianBuildDeps a
ctl = (ControlFileError -> Maybe Relations)
-> (Maybe Relations -> Maybe Relations)
-> Either ControlFileError (Maybe Relations)
-> Maybe Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ControlFileError -> Maybe Relations
forall a e. Exception e => e -> a
throw Maybe Relations -> Maybe Relations
forall a. a -> a
id (Either ControlFileError (Maybe Relations) -> Maybe Relations)
-> Either ControlFileError (Maybe Relations) -> Maybe Relations
forall a b. (a -> b) -> a -> b
$ String
-> DebianControl -> Either ControlFileError (Maybe Relations)
forall a.
HasDebianControl a =>
String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
"Build-Depends" (a -> DebianControl
forall a. HasDebianControl a => a -> DebianControl
debianControl a
ctl)

-- | Version of fieldValue that may throw a ControlFileError.  We only
-- use this internally on fields that we already validated.
fieldValue' :: ControlFunctions text => String -> Paragraph' text -> text
fieldValue' :: String -> Paragraph' text -> text
fieldValue' String
fieldName Paragraph' text
paragraph = text -> (text -> text) -> Maybe text -> text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ControlFileError -> text
forall a e. Exception e => e -> a
throw (ControlFileError -> text) -> ControlFileError -> text
forall a b. (a -> b) -> a -> b
$ [Loc] -> String -> ControlFileError
MissingField [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__] String
fieldName) text -> text
forall a. a -> a
id (Maybe text -> text) -> Maybe text -> text
forall a b. (a -> b) -> a -> b
$ String -> Paragraph' text -> Maybe text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
fieldName Paragraph' text
paragraph

-- | This could access fields we haven't validated, so
-- it can return an error.  Additionally, the field might
-- be absent, in which case it returns Nothing.
debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)
debianRelations :: String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
fieldName a
ctl = Either ControlFileError (Maybe Relations)
-> (Text -> Either ControlFileError (Maybe Relations))
-> Maybe Text
-> Either ControlFileError (Maybe Relations)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Relations -> Either ControlFileError (Maybe Relations)
forall a b. b -> Either a b
Right Maybe Relations
forall a. Maybe a
Nothing) ((ParseError -> Either ControlFileError (Maybe Relations))
-> (Relations -> Either ControlFileError (Maybe Relations))
-> Either ParseError Relations
-> Either ControlFileError (Maybe Relations)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ControlFileError -> Either ControlFileError (Maybe Relations)
forall a b. a -> Either a b
Left (ControlFileError -> Either ControlFileError (Maybe Relations))
-> (ParseError -> ControlFileError)
-> ParseError
-> Either ControlFileError (Maybe Relations)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseRelationsError [Int
String
Loc :: String -> String -> String -> CharPos -> CharPos -> Loc
loc_filename :: String
loc_package :: String
loc_module :: String
loc_start :: CharPos
loc_end :: CharPos
$__LOC__]) (Maybe Relations -> Either ControlFileError (Maybe Relations)
forall a b. b -> Either a b
Right (Maybe Relations -> Either ControlFileError (Maybe Relations))
-> (Relations -> Maybe Relations)
-> Relations
-> Either ControlFileError (Maybe Relations)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relations -> Maybe Relations
forall a. a -> Maybe a
Just) (Either ParseError Relations
 -> Either ControlFileError (Maybe Relations))
-> (Text -> Either ParseError Relations)
-> Text
-> Either ControlFileError (Maybe Relations)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations) (Maybe Text -> Either ControlFileError (Maybe Relations))
-> Maybe Text -> Either ControlFileError (Maybe Relations)
forall a b. (a -> b) -> a -> b
$ String -> Paragraph' Text -> Maybe Text
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
fieldName (a -> Paragraph' Text
forall a. HasDebianControl a => a -> Paragraph' Text
debianSourceParagraph a
ctl)

-- | Apply a function to the text from a named field in a control file paragraph.
mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue Text -> a
f String
fieldName Paragraph' Text
paragraph = Text -> a
f (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ String -> Paragraph' Text -> Text
forall text.
ControlFunctions text =>
String -> Paragraph' text -> text
fieldValue' String
fieldName Paragraph' Text
paragraph