{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TemplateHaskell #-}
{-# OPTIONS_GHC -Wall #-}
module Debian.Control.Policy
(
DebianControl(unDebianControl)
, validateDebianControl
, unsafeDebianControl
, parseDebianControlFromFile
, parseDebianControl
, ControlFileError(..)
, HasDebianControl(debianControl)
, 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 Text.Parsec.Error (ParseError)
data DebianControl = DebianControl {DebianControl -> Control' Text
unDebianControl :: Control' Text}
instance Show DebianControl where
show :: DebianControl -> String
show DebianControl
c = String
"(parseDebianControl \"\" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Pretty a => a -> String
prettyShow (DebianControl -> Control' Text
unDebianControl DebianControl
c)) forall a. [a] -> [a] -> [a]
++ String
")"
validateDebianControl :: MonadCatch m => Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl :: forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl Control' Text
ctl =
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (do (SrcPkgName, [BinPkgName])
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
Maybe Relations
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
Maybe Relations
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep (Control' Text -> DebianControl
DebianControl Control' Text
ctl)
forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (\ ()
_ -> forall a b. b -> Either a b
Right 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 :: forall (m :: * -> *).
MonadCatch m =>
String -> Text -> m (Either ControlFileError DebianControl)
parseDebianControl String
sourceName Text
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseControlError [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__]) forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl (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 =
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
controlPath) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> IOError -> ControlFileError
IOError [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__])
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseControlError [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__]) forall (m :: * -> *).
MonadCatch m =>
Control' Text -> m (Either ControlFileError DebianControl)
validateDebianControl)
class Show a => HasDebianControl a where
debianControl :: a -> DebianControl
instance HasDebianControl DebianControl where
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 = forall a. a -> a
id
instance HasControl DebianControl where
control :: DebianControl -> Control' Text
control = DebianControl -> Control' Text
unDebianControl
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]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": NoParagraphs"
show (NoBinaryParagraphs {String
[Loc]
ctl :: String
locs :: [Loc]
ctl :: ControlFileError -> String
locs :: ControlFileError -> [Loc]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": NoBinaryParagraphs"
show (MissingField {String
[Loc]
field :: String
locs :: [Loc]
field :: ControlFileError -> String
locs :: ControlFileError -> [Loc]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": MissingField " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
field
show (ParseRelationsError {[Loc]
ParseError
parseError :: ParseError
locs :: [Loc]
parseError :: ControlFileError -> ParseError
locs :: ControlFileError -> [Loc]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": ParseRelationsError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
parseError
show (ParseControlError {[Loc]
ParseError
parseError :: ParseError
locs :: [Loc]
parseError :: ControlFileError -> ParseError
locs :: ControlFileError -> [Loc]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": ParseControlError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
parseError
show (IOError {[Loc]
IOError
ioError :: IOError
locs :: [Loc]
ioError :: ControlFileError -> IOError
locs :: ControlFileError -> [Loc]
..}) = forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Loc -> String
showLoc [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": IOError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOError
ioError
showLoc :: Loc -> String
showLoc :: Loc -> String
showLoc Loc
x = forall a. Show a => a -> String
show (Loc -> String
loc_filename Loc
x) forall a. [a] -> [a] -> [a]
++ String
"(line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a, b) -> a
fst (Loc -> CharPos
loc_start Loc
x)) forall a. [a] -> [a] -> [a]
++ String
", column " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a, b) -> b
snd (Loc -> CharPos
loc_start Loc
x)) forall a. [a] -> [a] -> [a]
++ String
")"
instance Exception ControlFileError
instance Eq ControlFileError where
ControlFileError
_ == :: ControlFileError -> ControlFileError -> Bool
== ControlFileError
_ = Bool
False
debianPackageParagraphs :: HasDebianControl a => a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs :: forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs a
ctl =
case forall a. HasDebianControl a => a -> DebianControl
removeCommentParagraphs a
ctl of
DebianControl (Control [Paragraph' Text
_]) -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Loc] -> String -> ControlFileError
NoBinaryParagraphs [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__] (forall a. Show a => a -> String
show a
ctl)
DebianControl (Control []) -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Loc] -> ControlFileError
NoParagraphs [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__]
DebianControl (Control (Paragraph' Text
sourceParagraph : [Paragraph' Text]
binParagraphs)) -> (Paragraph' Text
sourceParagraph, [Paragraph' Text]
binParagraphs)
removeCommentParagraphs :: HasDebianControl a => a -> DebianControl
a
c =
Control' Text -> DebianControl
DebianControl (forall a. [Paragraph' a] -> Control' a
Control (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Paragraph' a -> Bool
isCommentParagraph) (forall a. Control' a -> [Paragraph' a]
unControl (DebianControl -> Control' Text
unDebianControl (forall a. HasDebianControl a => a -> DebianControl
debianControl a
c)))))
where
isCommentParagraph :: Paragraph' a -> Bool
isCommentParagraph (Paragraph [Field' a]
fields) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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 :: forall a. HasDebianControl a => a -> Paragraph' Text
debianSourceParagraph = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs
debianBinaryParagraphs :: HasDebianControl a => a -> [Paragraph' Text]
debianBinaryParagraphs :: forall a. HasDebianControl a => a -> [Paragraph' Text]
debianBinaryParagraphs = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs
debianPackageNames :: HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames :: forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames a
c =
let (Paragraph' Text
srcParagraph, [Paragraph' Text]
binParagraphs) = forall a.
HasDebianControl a =>
a -> (Paragraph' Text, [Paragraph' Text])
debianPackageParagraphs a
c in
(forall a. (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue (String -> SrcPkgName
SrcPkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList) String
"Source" Paragraph' Text
srcParagraph, forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue (String -> BinPkgName
BinPkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList) String
"Package") [Paragraph' Text]
binParagraphs)
debianSourcePackageName :: HasDebianControl a => a -> SrcPkgName
debianSourcePackageName :: forall a. HasDebianControl a => a -> SrcPkgName
debianSourcePackageName = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames
debianBinaryPackageNames :: HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames :: forall a. HasDebianControl a => a -> [BinPkgName]
debianBinaryPackageNames = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasDebianControl a => a -> (SrcPkgName, [BinPkgName])
debianPackageNames
debianBuildDepsIndep :: HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep :: forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDepsIndep a
ctl = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
HasDebianControl a =>
String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
"Build-Depends-Indep" (forall a. HasDebianControl a => a -> DebianControl
debianControl a
ctl)
debianBuildDeps :: HasDebianControl a => a -> Maybe Relations
debianBuildDeps :: forall a. HasDebianControl a => a -> Maybe Relations
debianBuildDeps a
ctl = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a.
HasDebianControl a =>
String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
"Build-Depends" (forall a. HasDebianControl a => a -> DebianControl
debianControl a
ctl)
fieldValue' :: ControlFunctions text => String -> Paragraph' text -> text
fieldValue' :: forall text.
ControlFunctions text =>
String -> Paragraph' text -> text
fieldValue' String
fieldName Paragraph' text
paragraph = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ [Loc] -> String -> ControlFileError
MissingField [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__] String
fieldName) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
fieldName Paragraph' text
paragraph
debianRelations :: HasDebianControl a => String -> a -> Either ControlFileError (Maybe Relations)
debianRelations :: forall a.
HasDebianControl a =>
String -> a -> Either ControlFileError (Maybe Relations)
debianRelations String
fieldName a
ctl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> ParseError -> ControlFileError
ParseRelationsError [$Int
String
loc_end :: CharPos
loc_filename :: String
loc_module :: String
loc_package :: String
loc_start :: CharPos
__LOC__]) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations) forall a b. (a -> b) -> a -> b
$ forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
fieldName (forall a. HasDebianControl a => a -> Paragraph' Text
debianSourceParagraph a
ctl)
mapFieldValue :: (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue :: forall a. (Text -> a) -> String -> Paragraph' Text -> a
mapFieldValue Text -> a
f String
fieldName Paragraph' Text
paragraph = Text -> a
f forall a b. (a -> b) -> a -> b
$ forall text.
ControlFunctions text =>
String -> Paragraph' text -> text
fieldValue' String
fieldName Paragraph' Text
paragraph