{-# LANGUAGE FlexibleInstances, OverloadedStrings, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Debian.Sources
    {- ( SourceType(..)
    , SourceOption(..)
    , SourceOp(..)
    , DebSource(..)
    , parseSourceLine
    , parseSourceLine'
    , parseSourcesList
    ) -} where

import Control.Lens (makeLenses, review, view)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Text (Text)
import Debian.Codename (Codename, codename, parseCodename)
import Debian.Pretty (PP(..))
import Debian.Release
import Debian.TH (here, Loc)
import Debian.VendorURI (parseVendorURI, VendorURI, vendorURI)
import Network.URI (parseURI, unEscapeString, escapeURIString, isAllowedInURI)
import Test.HUnit
import Text.ParserCombinators.Parsec
import Text.PrettyPrint (hcat, punctuate, render, text)
import Distribution.Pretty (Pretty(pretty), prettyShow)

data SourceType
    = Deb | DebSrc
    deriving (SourceType -> SourceType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceType -> SourceType -> Bool
$c/= :: SourceType -> SourceType -> Bool
== :: SourceType -> SourceType -> Bool
$c== :: SourceType -> SourceType -> Bool
Eq, Eq SourceType
SourceType -> SourceType -> Bool
SourceType -> SourceType -> Ordering
SourceType -> SourceType -> SourceType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceType -> SourceType -> SourceType
$cmin :: SourceType -> SourceType -> SourceType
max :: SourceType -> SourceType -> SourceType
$cmax :: SourceType -> SourceType -> SourceType
>= :: SourceType -> SourceType -> Bool
$c>= :: SourceType -> SourceType -> Bool
> :: SourceType -> SourceType -> Bool
$c> :: SourceType -> SourceType -> Bool
<= :: SourceType -> SourceType -> Bool
$c<= :: SourceType -> SourceType -> Bool
< :: SourceType -> SourceType -> Bool
$c< :: SourceType -> SourceType -> Bool
compare :: SourceType -> SourceType -> Ordering
$ccompare :: SourceType -> SourceType -> Ordering
Ord, Int -> SourceType -> ShowS
[SourceType] -> ShowS
SourceType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceType] -> ShowS
$cshowList :: [SourceType] -> ShowS
show :: SourceType -> String
$cshow :: SourceType -> String
showsPrec :: Int -> SourceType -> ShowS
$cshowsPrec :: Int -> SourceType -> ShowS
Show)

-- arch
-- lang
-- target
-- pdiffs
-- by-hash
-- allow-insecure=no
-- allow-weak=no
-- allow-downgrade-to-insecure=no
-- trusted=no
-- signed-by
-- check-valid-until
-- valid-until-min
-- valid-until-max
data SourceOption
    = SourceOption String SourceOp [String]
    deriving (SourceOption -> SourceOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceOption -> SourceOption -> Bool
$c/= :: SourceOption -> SourceOption -> Bool
== :: SourceOption -> SourceOption -> Bool
$c== :: SourceOption -> SourceOption -> Bool
Eq, Eq SourceOption
SourceOption -> SourceOption -> Bool
SourceOption -> SourceOption -> Ordering
SourceOption -> SourceOption -> SourceOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceOption -> SourceOption -> SourceOption
$cmin :: SourceOption -> SourceOption -> SourceOption
max :: SourceOption -> SourceOption -> SourceOption
$cmax :: SourceOption -> SourceOption -> SourceOption
>= :: SourceOption -> SourceOption -> Bool
$c>= :: SourceOption -> SourceOption -> Bool
> :: SourceOption -> SourceOption -> Bool
$c> :: SourceOption -> SourceOption -> Bool
<= :: SourceOption -> SourceOption -> Bool
$c<= :: SourceOption -> SourceOption -> Bool
< :: SourceOption -> SourceOption -> Bool
$c< :: SourceOption -> SourceOption -> Bool
compare :: SourceOption -> SourceOption -> Ordering
$ccompare :: SourceOption -> SourceOption -> Ordering
Ord, Int -> SourceOption -> ShowS
[SourceOption] -> ShowS
SourceOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceOption] -> ShowS
$cshowList :: [SourceOption] -> ShowS
show :: SourceOption -> String
$cshow :: SourceOption -> String
showsPrec :: Int -> SourceOption -> ShowS
$cshowsPrec :: Int -> SourceOption -> ShowS
Show)

data SourceOp = OpSet | OpAdd | OpDel deriving (SourceOp -> SourceOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceOp -> SourceOp -> Bool
$c/= :: SourceOp -> SourceOp -> Bool
== :: SourceOp -> SourceOp -> Bool
$c== :: SourceOp -> SourceOp -> Bool
Eq, Eq SourceOp
SourceOp -> SourceOp -> Bool
SourceOp -> SourceOp -> Ordering
SourceOp -> SourceOp -> SourceOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceOp -> SourceOp -> SourceOp
$cmin :: SourceOp -> SourceOp -> SourceOp
max :: SourceOp -> SourceOp -> SourceOp
$cmax :: SourceOp -> SourceOp -> SourceOp
>= :: SourceOp -> SourceOp -> Bool
$c>= :: SourceOp -> SourceOp -> Bool
> :: SourceOp -> SourceOp -> Bool
$c> :: SourceOp -> SourceOp -> Bool
<= :: SourceOp -> SourceOp -> Bool
$c<= :: SourceOp -> SourceOp -> Bool
< :: SourceOp -> SourceOp -> Bool
$c< :: SourceOp -> SourceOp -> Bool
compare :: SourceOp -> SourceOp -> Ordering
$ccompare :: SourceOp -> SourceOp -> Ordering
Ord, Int -> SourceOp -> ShowS
[SourceOp] -> ShowS
SourceOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceOp] -> ShowS
$cshowList :: [SourceOp] -> ShowS
show :: SourceOp -> String
$cshow :: SourceOp -> String
showsPrec :: Int -> SourceOp -> ShowS
$cshowsPrec :: Int -> SourceOp -> ShowS
Show)

instance Pretty SourceOp where
    pretty :: SourceOp -> Doc
pretty SourceOp
OpSet = String -> Doc
text String
"="
    pretty SourceOp
OpAdd = String -> Doc
text String
"+="
    pretty SourceOp
OpDel = String -> Doc
text String
"-="

data DebSource
    = DebSource
    { DebSource -> SourceType
_sourceType :: SourceType
    , DebSource -> [SourceOption]
_sourceOptions :: [SourceOption]
    , DebSource -> VendorURI
_sourceUri :: VendorURI
    , DebSource -> Either String (Codename, [Section])
_sourceDist :: Either String (Codename, [Section])
    } deriving (DebSource -> DebSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebSource -> DebSource -> Bool
$c/= :: DebSource -> DebSource -> Bool
== :: DebSource -> DebSource -> Bool
$c== :: DebSource -> DebSource -> Bool
Eq, Eq DebSource
DebSource -> DebSource -> Bool
DebSource -> DebSource -> Ordering
DebSource -> DebSource -> DebSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DebSource -> DebSource -> DebSource
$cmin :: DebSource -> DebSource -> DebSource
max :: DebSource -> DebSource -> DebSource
$cmax :: DebSource -> DebSource -> DebSource
>= :: DebSource -> DebSource -> Bool
$c>= :: DebSource -> DebSource -> Bool
> :: DebSource -> DebSource -> Bool
$c> :: DebSource -> DebSource -> Bool
<= :: DebSource -> DebSource -> Bool
$c<= :: DebSource -> DebSource -> Bool
< :: DebSource -> DebSource -> Bool
$c< :: DebSource -> DebSource -> Bool
compare :: DebSource -> DebSource -> Ordering
$ccompare :: DebSource -> DebSource -> Ordering
Ord, Int -> DebSource -> ShowS
[DebSource] -> ShowS
DebSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebSource] -> ShowS
$cshowList :: [DebSource] -> ShowS
show :: DebSource -> String
$cshow :: DebSource -> String
showsPrec :: Int -> DebSource -> ShowS
$cshowsPrec :: Int -> DebSource -> ShowS
Show)

instance Pretty SourceType where
    pretty :: SourceType -> Doc
pretty SourceType
Deb = String -> Doc
text String
"deb"
    pretty SourceType
DebSrc = String -> Doc
text String
"deb-src"

instance Pretty SourceOption where
    pretty :: SourceOption -> Doc
pretty (SourceOption String
k SourceOp
op [String]
vs) = String -> Doc
text String
k forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty SourceOp
op forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
",") (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [String]
vs))

instance Pretty DebSource where
    pretty :: DebSource -> Doc
pretty (DebSource SourceType
thetype [SourceOption]
theoptions VendorURI
theuri Either String (Codename, [Section])
thedist) =
        [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" ")
                ([forall a. Pretty a => a -> Doc
pretty SourceType
thetype] forall a. [a] -> [a] -> [a]
++
                 (case [SourceOption]
theoptions of
                    [] -> []
                    [SourceOption]
_ -> [String -> Doc
text String
"[" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
", ") (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [SourceOption]
theoptions)) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"]) forall a. [a] -> [a] -> [a]
++
                 [String -> Doc
text (forall a. Show a => a -> String
show (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' VendorURI URI
vendorURI VendorURI
theuri))] forall a. [a] -> [a] -> [a]
++
                 case Either String (Codename, [Section])
thedist of
                   Left String
exactPath -> [String -> Doc
text ((Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isAllowedInURI String
exactPath)]
                   Right (Codename
dist, [Section]
sections) ->
                       forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text (Codename -> String
codename Codename
dist forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Section -> String
sectionName' [Section]
sections)))

instance Pretty (PP [DebSource]) where
    pretty :: PP [DebSource] -> Doc
pretty = [Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ DebSource
x -> forall a. Pretty a => a -> Doc
pretty DebSource
x forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PP a -> a
unPP

{-

deb uri distribution [component1] [componenent2] [...]

The URI for the deb type must specify the base of the Debian
distribution, from which APT will find the information it needs.

distribution can specify an exact path, in which case the components
must be omitted and distribution must end with a slash (/).

If distribution does not specify an exact path, at least one component
must be present.

Distribution may also contain a variable, $(ARCH), which expands to
the Debian architecture (i386, m68k, powerpc, ...)  used on the
system.

The rest of the line can be marked as a comment by using a #.

Additional Notes:

 + Lines can begin with leading white space.

 + If the dist ends with slash (/), then it must be an absolute path
   and it is an error to specify components after it.

-}

-- |quoteWords - similar to words, but with special handling of
-- double-quotes and brackets.
--
-- The handling double quotes and [] is supposed to match:
-- apt-0.6.44.2\/apt-pkg\/contrib\/strutl.cc:ParseQuoteWord()
--
-- The behaviour can be defined as:
--
--  Break the string into space seperated words ignoring spaces that
--  appear between \"\" or []. Strip trailing and leading white space
--  around words. Strip out double quotes, but leave the square
--  brackets intact.
quoteWords :: String -> [String]
quoteWords :: String -> [String]
quoteWords [] = []
quoteWords String
s = String -> [String]
quoteWords' (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') String
s)
    where
      quoteWords' :: String -> [String]
      quoteWords' :: String -> [String]
quoteWords' [] = []
      quoteWords' String
str =
          case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String
" [\"" :: String)) String
str of
            ([],[]) -> []
            (String
w, []) -> [String
w]
            (String
w, (Char
' ':String
rest)) -> String
w forall a. a -> [a] -> [a]
: (String -> [String]
quoteWords' (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') String
rest))
            (String
w, (Char
'"':String
rest)) ->
                case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'"') String
rest of
                  (String
w',(Char
'"':String
rest)) ->
                      case String -> [String]
quoteWords' String
rest of
                        [] ->  [String
w forall a. [a] -> [a] -> [a]
++ String
w']
                        (String
w'':[String]
ws) -> ((String
w forall a. [a] -> [a] -> [a]
++ String
w' forall a. [a] -> [a] -> [a]
++ String
w'')forall a. a -> [a] -> [a]
: [String]
ws)
                  (String
_w',[]) -> forall a. HasCallStack => String -> a
error (String
"quoteWords: missing \" in the string: "  forall a. [a] -> [a] -> [a]
++ String
s)
                  (String, String)
_ -> forall a. HasCallStack => String -> a
error (String
"the impossible happened in SourcesList.quoteWords")
            (String
w, (Char
'[':String
rest)) ->
                case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
']') String
rest of
                  (String
w',(Char
']':String
rest)) ->
                      case String -> [String]
quoteWords' String
rest of
                        []       -> [String
w forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ String
w' forall a. [a] -> [a] -> [a]
++ String
"]"]
                        (String
w'':[String]
ws) -> ((String
w forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ String
w' forall a. [a] -> [a] -> [a]
++ String
"]" forall a. [a] -> [a] -> [a]
++ String
w'')forall a. a -> [a] -> [a]
: [String]
ws)
                  (String
_w',[]) -> forall a. HasCallStack => String -> a
error (String
"quoteWords: missing ] in the string: "  forall a. [a] -> [a] -> [a]
++ String
s)
                  (String, String)
_ -> forall a. HasCallStack => String -> a
error (String
"the impossible happened in SourcesList.quoteWords")
            (String, String)
_ -> forall a. HasCallStack => String -> a
error (String
"the impossible happened in SourcesList.quoteWords")

stripLine :: String -> String
stripLine :: ShowS
stripLine = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'#') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ')

sourceLines :: String -> [String]
sourceLines :: String -> [String]
sourceLines = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- |parseSourceLine -- parses a source line
-- the argument must be a non-empty, valid source line with comments stripped
-- see: 'sourceLines'
parseSourceLine :: [Loc] -> String -> DebSource
parseSourceLine :: [Loc] -> String -> DebSource
parseSourceLine [Loc]
locs String
str = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id ([Loc] -> String -> Either String DebSource
parseSourceLine' [Loc]
locs String
str)
{-
    case quoteWords str of
      (theTypeStr : theUriStr : theDistStr : sectionStrs) ->
          let sections = map parseSection' sectionStrs
              theType = case unEscapeString theTypeStr of
                          "deb" -> Deb
                          "deb-src" -> DebSrc
                          o -> error ("parseSourceLine: invalid type " ++ o ++ " in line:\n" ++ str)
              theUri = case parseURI theUriStr of
                         Nothing -> error ("parseSourceLine: invalid uri " ++ theUriStr ++ " in the line:\n" ++ str)
                         Just u -> u
              theDist = unEscapeString theDistStr
          in
            case last theDist of
              '/' -> if null sections
                      then DebSource { sourceType = theType, sourceOptions = [], sourceUri = theUri, sourceDist = Left theDist }
                      else error ("parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" ++ str)
              _ -> if null sections
                    then error ("parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" ++ str)
                    else DebSource { sourceType = theType, sourceOptions = [], sourceUri = theUri, sourceDist = Right (parseReleaseName theDist, sections) }
      _ -> error ("parseSourceLine: invalid line in sources.list:\n" ++ str)
-}

parseOptions :: String -> Either ParseError [SourceOption]
parseOptions :: String -> Either ParseError [SourceOption]
parseOptions String
s = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse CharParser () [SourceOption]
pOptions String
s String
s

pOptions :: CharParser () [SourceOption]
pOptions :: CharParser () [SourceOption]
pOptions = do Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
              forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
              [SourceOption]
opts <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser () SourceOption
pOption (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
              forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
              Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
              forall (m :: * -> *) a. Monad m => a -> m a
return [SourceOption]
opts

pOption :: CharParser () SourceOption
pOption :: CharParser () SourceOption
pOption = do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
             String
key <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'+',Char
'-',Char
'=',Char
' ',Char
'\t'])
             forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
             SourceOp
op <- CharParser () SourceOp
pOp
             forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
             [String]
values <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
',',Char
']',Char
' ',Char
'\t'])) (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
             forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ',Char
'\t'])
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> SourceOp -> [String] -> SourceOption
SourceOption String
key SourceOp
op [String]
values

pOp :: CharParser () SourceOp
pOp :: CharParser () SourceOp
pOp = do (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SourceOp
OpAdd)
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
         (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SourceOp
OpDel)
         forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
         (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SourceOp
OpSet)

parseSourceLine' :: [Loc] -> String -> Either String DebSource
parseSourceLine' :: [Loc] -> String -> Either String DebSource
parseSourceLine' [Loc]
locs String
str =
    case String -> [String]
quoteWords String
str of
      String
theTypeStr : theOptionStr :: String
theOptionStr@(Char
'[' : String
_) : String
theURIStr : String
theDistStr : [String]
sectionStrs ->
          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
. forall a. Show a => a -> String
show)
            (\[SourceOption]
opts -> String
-> [SourceOption]
-> String
-> String
-> [String]
-> Either String DebSource
go String
theTypeStr [SourceOption]
opts String
theURIStr String
theDistStr [String]
sectionStrs)
            (String -> Either ParseError [SourceOption]
parseOptions String
theOptionStr)
      String
theTypeStr : String
theURIStr : String
theDistStr : [String]
sectionStrs ->
          String
-> [SourceOption]
-> String
-> String
-> [String]
-> Either String DebSource
go String
theTypeStr [] String
theURIStr String
theDistStr [String]
sectionStrs
      [String]
_ -> forall a b. a -> Either a b
Left (String
"parseSourceLine: invalid line in sources.list:\n" forall a. [a] -> [a] -> [a]
++ String
str)
    where
      go :: String -> [SourceOption] -> String -> String -> [String] -> Either String DebSource
      go :: String
-> [SourceOption]
-> String
-> String
-> [String]
-> Either String DebSource
go String
theTypeStr [SourceOption]
theOptions String
theURIStr String
theDistStr [String]
sectionStrs =
          let sections :: [Section]
sections = forall a b. (a -> b) -> [a] -> [b]
map String -> Section
parseSection' [String]
sectionStrs
              theType :: Either String SourceType
theType = case ShowS
unEscapeString String
theTypeStr of
                          String
"deb" -> forall a b. b -> Either a b
Right SourceType
Deb
                          String
"deb-src" -> forall a b. b -> Either a b
Right SourceType
DebSrc
                          String
s -> forall a b. a -> Either a b
Left (String
"parseSourceLine" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
here forall a. a -> [a] -> [a]
: [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": invalid type " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
" in line:\n" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
" str=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str)
              theURI :: Either String VendorURI
theURI = case [Loc] -> String -> Maybe VendorURI
parseVendorURI ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
here forall a. a -> [a] -> [a]
: [Loc]
locs) String
theURIStr of
                         Maybe VendorURI
Nothing -> forall a b. a -> Either a b
Left (String
"parseSourceLine' " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
here forall a. a -> [a] -> [a]
: [Loc]
locs) forall a. [a] -> [a] -> [a]
++ String
": invalid uri " forall a. [a] -> [a] -> [a]
++ String
theURIStr forall a. [a] -> [a] -> [a]
++ String
" str=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str)
                         Just VendorURI
u -> forall a b. b -> Either a b
Right VendorURI
u
              theDist :: String
theDist = ShowS
unEscapeString String
theDistStr
          in
            case (forall a. [a] -> a
last String
theDist, Either String SourceType
theType, Either String VendorURI
theURI) of
              (Char
'/', Right SourceType
typ, Right VendorURI
uri) -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section]
sections
                      then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DebSource { _sourceType :: SourceType
_sourceType = SourceType
typ, _sourceOptions :: [SourceOption]
_sourceOptions = [SourceOption]
theOptions, _sourceUri :: VendorURI
_sourceUri = VendorURI
uri, _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. a -> Either a b
Left String
theDist }
                      else forall a b. a -> Either a b
Left (String
"parseSourceLine: Dist is an exact path, so sections are not allowed on the line:\n" forall a. [a] -> [a] -> [a]
++ String
str)
              (Char
_, Right SourceType
typ, Right VendorURI
uri) -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section]
sections
                    then forall a b. a -> Either a b
Left (String
"parseSourceLine: Dist is not an exact path, so at least one section is required on the line:\n" forall a. [a] -> [a] -> [a]
++ String
str)
                    else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DebSource { _sourceType :: SourceType
_sourceType = SourceType
typ, _sourceOptions :: [SourceOption]
_sourceOptions = [SourceOption]
theOptions, _sourceUri :: VendorURI
_sourceUri = VendorURI
uri, _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. b -> Either a b
Right ((String -> Codename
parseCodename String
theDist), [Section]
sections) }
              (Char
_, Left String
msg, Either String VendorURI
_) -> forall a b. a -> Either a b
Left String
msg
              (Char
_, Either String SourceType
_, Left String
msg) -> forall a b. a -> Either a b
Left String
msg

parseSourcesList :: [Loc] -> String -> [DebSource]
parseSourcesList :: [Loc] -> String -> [DebSource]
parseSourcesList [Loc]
locs = forall a b. (a -> b) -> [a] -> [b]
map ([Loc] -> String -> DebSource
parseSourceLine [Loc]
locs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
sourceLines

-- * Unit Tests

-- TODO: add test cases that test for unterminated double-quote or bracket
testQuoteWords :: Test
testQuoteWords :: Test
testQuoteWords =
    forall t. (Testable t, HasCallStack) => t -> Test
test [ forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, no quoting" [String
"hello", String
"world",String
"!"] (String -> [String]
quoteWords String
"  hello    world !  ")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, double quotes" [String
"hello  world",String
"!"] (String -> [String]
quoteWords String
"  hel\"lo  world\" !  ")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, square brackets" [String
"hel[lo  worl]d",String
"!"] (String -> [String]
quoteWords String
"  hel[lo  worl]d ! ")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, square-bracket at end" [String
"hel[lo world]"] (String -> [String]
quoteWords String
" hel[lo world]")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, double quote at end" [String
"hello world"] (String -> [String]
quoteWords String
" hel\"lo world\"")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, square-bracket at beginning" [String
"[hello wo]rld",String
"!"] (String -> [String]
quoteWords String
"[hello wo]rld !")
         , forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"Space seperate words, double quote at beginning" [String
"hello world",String
"!"] (String -> [String]
quoteWords String
"\"hello wor\"ld !")
         ]

testSourcesList :: Test
testSourcesList :: Test
testSourcesList =
    forall t. (Testable t, HasCallStack) => t -> Test
test [ forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"parse and pretty sources.list" String
validSourcesListExpected (Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> String -> [DebSource]
parseSourcesList [$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
here] forall a b. (a -> b) -> a -> b
$ String
validSourcesListStr) ]

testSourcesList2 :: Test
testSourcesList2 :: Test
testSourcesList2 =
    forall t. (Testable t, HasCallStack) => t -> Test
test [ forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"pretty sources.list" String
validSourcesListExpected (Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall a b. (a -> b) -> a -> b
$ [DebSource]
validSourcesList) ]

validSourcesListStr :: String
validSourcesListStr :: String
validSourcesListStr =
          [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [ String
" # A comment only line "
                    , String
" deb ftp://ftp.debian.org/debian unstable main contrib non-free # typical deb line"
                    , String
" deb-src ftp://ftp.debian.org/debian unstable main contrib non-free # typical deb-src line"
                    , String
""
                    , String
"# comment line"
                    , String
"deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ # exact path"
                    , String
"deb [trusted=yes] http://ftp.debian.org/whee \"space dist\" main"
                    , String
"deb [trusted=yes] http://ftp.debian.org/whee dist space%20section"
                    ]

validSourcesList :: [DebSource]
validSourcesList :: [DebSource]
validSourcesList =
    [DebSource {_sourceType :: SourceType
_sourceType = SourceType
Deb, _sourceOptions :: [SourceOption]
_sourceOptions = [], _sourceUri :: VendorURI
_sourceUri = (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (String -> Maybe URI
parseURI String
"ftp://ftp.debian.org/debian"), _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. b -> Either a b
Right (String -> Codename
parseCodename String
"unstable",[String -> Section
Section String
"main",String -> Section
Section String
"contrib",String -> Section
Section String
"non-free"])},
     DebSource {_sourceType :: SourceType
_sourceType = SourceType
DebSrc, _sourceOptions :: [SourceOption]
_sourceOptions = [], _sourceUri :: VendorURI
_sourceUri = (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (String -> Maybe URI
parseURI String
"ftp://ftp.debian.org/debian"), _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. b -> Either a b
Right (String -> Codename
parseCodename String
"unstable",[String -> Section
Section String
"main",String -> Section
Section String
"contrib",String -> Section
Section String
"non-free"])},
     DebSource {_sourceType :: SourceType
_sourceType = SourceType
Deb, _sourceOptions :: [SourceOption]
_sourceOptions = [], _sourceUri :: VendorURI
_sourceUri = (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (String -> Maybe URI
parseURI String
"http://pkg-kde.alioth.debian.org/kde-3.5.0/"), _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. a -> Either a b
Left String
"./"},
     DebSource {_sourceType :: SourceType
_sourceType = SourceType
Deb, _sourceOptions :: [SourceOption]
_sourceOptions = [String -> SourceOp -> [String] -> SourceOption
SourceOption String
"trusted" SourceOp
OpSet [String
"yes"]], _sourceUri :: VendorURI
_sourceUri = (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (String -> Maybe URI
parseURI String
"http://ftp.debian.org/whee"), _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. b -> Either a b
Right (String -> Codename
parseCodename String
"space dist",[String -> Section
Section String
"main"])},
     DebSource {_sourceType :: SourceType
_sourceType = SourceType
Deb, _sourceOptions :: [SourceOption]
_sourceOptions = [String -> SourceOp -> [String] -> SourceOption
SourceOption String
"trusted" SourceOp
OpSet [String
"yes"]], _sourceUri :: VendorURI
_sourceUri = (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' VendorURI URI
vendorURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) (String -> Maybe URI
parseURI String
"http://ftp.debian.org/whee"), _sourceDist :: Either String (Codename, [Section])
_sourceDist = forall a b. b -> Either a b
Right (String -> Codename
parseCodename String
"dist",[String -> Section
Section String
"space section"])}]

validSourcesListExpected :: String
validSourcesListExpected :: String
validSourcesListExpected =
          [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [ String
"deb ftp://ftp.debian.org/debian unstable main contrib non-free"
                    , String
"deb-src ftp://ftp.debian.org/debian unstable main contrib non-free"
                    , String
"deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./"
                    , String
"deb [trusted=yes] http://ftp.debian.org/whee space%20dist main"
                    , String
"deb [trusted=yes] http://ftp.debian.org/whee dist space%20section"
                    ]
_invalidSourcesListStr1 :: Text
_invalidSourcesListStr1 :: Text
_invalidSourcesListStr1 = Text
"deb http://pkg-kde.alioth.debian.org/kde-3.5.0/ ./ main contrib non-free # exact path with sections"

testSourcesListParse :: Test
testSourcesListParse :: Test
testSourcesListParse =
    forall t. (Testable t, HasCallStack) => t -> Test
test [ forall a.
(HasCallStack, Eq a, Show a) =>
String -> a -> a -> Assertion
assertEqual String
"" String
gutsy (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Semigroup a => a -> a -> a
<> String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> String -> [DebSource]
parseSourcesList [$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
here] forall a b. (a -> b) -> a -> b
$ String
gutsy) ]
    where
      gutsy :: String
gutsy = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"deb http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n",
                      String
"deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy main restricted universe multiverse\n",
                      String
"deb http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n",
                      String
"deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-updates main restricted universe multiverse\n",
                      String
"deb http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n",
                      String
"deb-src http://us.archive.ubuntu.com/ubuntu/ gutsy-backports main restricted universe multiverse\n",
                      String
"deb http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n",
                      String
"deb-src http://security.ubuntu.com/ubuntu/ gutsy-security main restricted universe multiverse\n"]

sourcesListTests :: Test
sourcesListTests :: Test
sourcesListTests =
    [Test] -> Test
TestList [ Test
testQuoteWords, Test
testSourcesList, Test
testSourcesList2, Test
testSourcesListParse ]

$(makeLenses ''DebSource)