-- | This module name is spurious - "Release" is not an official term
-- in the debian documentation.

{-# LANGUAGE DeriveDataTypeable #-}

module Debian.Release
    ( Section(..)
    , SubSection(..)
    , sectionName
    , sectionName'
    , sectionNameOfSubSection
    , parseSection
    , parseSection'
    ) where

import Network.URI (unEscapeString, escapeURIString, isAllowedInURI)

-- |A section of a repository such as main, contrib, non-free,
-- restricted.  The indexes for a section are located below the
-- distribution directory.
newtype Section = Section String deriving (ReadPrec [Section]
ReadPrec Section
Int -> ReadS Section
ReadS [Section]
(Int -> ReadS Section)
-> ReadS [Section]
-> ReadPrec Section
-> ReadPrec [Section]
-> Read Section
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Section]
$creadListPrec :: ReadPrec [Section]
readPrec :: ReadPrec Section
$creadPrec :: ReadPrec Section
readList :: ReadS [Section]
$creadList :: ReadS [Section]
readsPrec :: Int -> ReadS Section
$creadsPrec :: Int -> ReadS Section
Read, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show, Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Eq Section
Eq Section
-> (Section -> Section -> Ordering)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Section)
-> (Section -> Section -> Section)
-> Ord Section
Section -> Section -> Bool
Section -> Section -> Ordering
Section -> Section -> Section
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 :: Section -> Section -> Section
$cmin :: Section -> Section -> Section
max :: Section -> Section -> Section
$cmax :: Section -> Section -> Section
>= :: Section -> Section -> Bool
$c>= :: Section -> Section -> Bool
> :: Section -> Section -> Bool
$c> :: Section -> Section -> Bool
<= :: Section -> Section -> Bool
$c<= :: Section -> Section -> Bool
< :: Section -> Section -> Bool
$c< :: Section -> Section -> Bool
compare :: Section -> Section -> Ordering
$ccompare :: Section -> Section -> Ordering
$cp1Ord :: Eq Section
Ord)

-- |A package's subsection is only evident in its control information,
-- packages from different subsections all reside in the same index.
data SubSection = SubSection { SubSection -> Section
section :: Section, SubSection -> String
subSectionName :: String } deriving (ReadPrec [SubSection]
ReadPrec SubSection
Int -> ReadS SubSection
ReadS [SubSection]
(Int -> ReadS SubSection)
-> ReadS [SubSection]
-> ReadPrec SubSection
-> ReadPrec [SubSection]
-> Read SubSection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubSection]
$creadListPrec :: ReadPrec [SubSection]
readPrec :: ReadPrec SubSection
$creadPrec :: ReadPrec SubSection
readList :: ReadS [SubSection]
$creadList :: ReadS [SubSection]
readsPrec :: Int -> ReadS SubSection
$creadsPrec :: Int -> ReadS SubSection
Read, Int -> SubSection -> ShowS
[SubSection] -> ShowS
SubSection -> String
(Int -> SubSection -> ShowS)
-> (SubSection -> String)
-> ([SubSection] -> ShowS)
-> Show SubSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubSection] -> ShowS
$cshowList :: [SubSection] -> ShowS
show :: SubSection -> String
$cshow :: SubSection -> String
showsPrec :: Int -> SubSection -> ShowS
$cshowsPrec :: Int -> SubSection -> ShowS
Show, SubSection -> SubSection -> Bool
(SubSection -> SubSection -> Bool)
-> (SubSection -> SubSection -> Bool) -> Eq SubSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubSection -> SubSection -> Bool
$c/= :: SubSection -> SubSection -> Bool
== :: SubSection -> SubSection -> Bool
$c== :: SubSection -> SubSection -> Bool
Eq, Eq SubSection
Eq SubSection
-> (SubSection -> SubSection -> Ordering)
-> (SubSection -> SubSection -> Bool)
-> (SubSection -> SubSection -> Bool)
-> (SubSection -> SubSection -> Bool)
-> (SubSection -> SubSection -> Bool)
-> (SubSection -> SubSection -> SubSection)
-> (SubSection -> SubSection -> SubSection)
-> Ord SubSection
SubSection -> SubSection -> Bool
SubSection -> SubSection -> Ordering
SubSection -> SubSection -> SubSection
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 :: SubSection -> SubSection -> SubSection
$cmin :: SubSection -> SubSection -> SubSection
max :: SubSection -> SubSection -> SubSection
$cmax :: SubSection -> SubSection -> SubSection
>= :: SubSection -> SubSection -> Bool
$c>= :: SubSection -> SubSection -> Bool
> :: SubSection -> SubSection -> Bool
$c> :: SubSection -> SubSection -> Bool
<= :: SubSection -> SubSection -> Bool
$c<= :: SubSection -> SubSection -> Bool
< :: SubSection -> SubSection -> Bool
$c< :: SubSection -> SubSection -> Bool
compare :: SubSection -> SubSection -> Ordering
$ccompare :: SubSection -> SubSection -> Ordering
$cp1Ord :: Eq SubSection
Ord)

sectionName :: SubSection -> String
sectionName :: SubSection -> String
sectionName (SubSection (Section String
"main") String
y) = String
y
sectionName (SubSection Section
x String
y) = Section -> String
sectionName' Section
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y

sectionName' :: Section -> String
sectionName' :: Section -> String
sectionName' (Section String
s) = (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isAllowedInURI String
s

sectionNameOfSubSection :: SubSection -> String
sectionNameOfSubSection :: SubSection -> String
sectionNameOfSubSection = Section -> String
sectionName' (Section -> String)
-> (SubSection -> Section) -> SubSection -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubSection -> Section
section

-- |Parse the value that appears in the @Section@ field of a .changes file.
-- (Does this need to be unesacped?)
parseSection :: String -> SubSection
parseSection :: String -> SubSection
parseSection String
s =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
s of
      (String
x, String
"") -> Section -> String -> SubSection
SubSection (String -> Section
Section String
"main") String
x
      (String
"main", String
y) -> Section -> String -> SubSection
SubSection (String -> Section
Section String
"main") String
y
      (String
x, String
y) -> Section -> String -> SubSection
SubSection (String -> Section
Section String
x) (ShowS
forall a. [a] -> [a]
tail String
y)

parseSection' :: String -> Section
parseSection' :: String -> Section
parseSection' String
name =
    String -> Section
Section (ShowS
unEscapeString String
name)