{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
module Debian.Util.FakeChanges (fakeChanges) where

--import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Data (Data, Typeable)
import Data.Digest.Pure.SHA as SHA
import Data.Foldable (concat, all, foldr)
import Data.List as List (intercalate, nub, partition, isSuffixOf)
import Data.Maybe
import Debian.Pretty (prettyShow)
import Data.Traversable
import Debian.Control
import qualified Debian.Deb as Deb
import Debian.Time
import Network.HostName (getHostName)
import Prelude hiding (concat, foldr, all, mapM, sum)
import System.Environment
import System.FilePath
import System.Posix.Files
import Text.Regex.TDFA

data Error
    = NoDebs
    | TooManyDscs [FilePath]
    | TooManyTars [FilePath]
    | TooManyDiffs [FilePath]
    | UnknownFiles [FilePath]
    | MalformedDebFilename [FilePath]
    | VersionMismatch [Maybe String]
    deriving (ReadPrec [Error]
ReadPrec Error
Int -> ReadS Error
ReadS [Error]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Error]
$creadListPrec :: ReadPrec [Error]
readPrec :: ReadPrec Error
$creadPrec :: ReadPrec Error
readList :: ReadS [Error]
$creadList :: ReadS [Error]
readsPrec :: Int -> ReadS Error
$creadsPrec :: Int -> ReadS Error
Read, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Typeable, Typeable Error
Error -> DataType
Error -> Constr
(forall b. Data b => b -> b) -> Error -> Error
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
forall u. (forall d. Data d => d -> u) -> Error -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapT :: (forall b. Data b => b -> b) -> Error -> Error
$cgmapT :: (forall b. Data b => b -> b) -> Error -> Error
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
dataTypeOf :: Error -> DataType
$cdataTypeOf :: Error -> DataType
toConstr :: Error -> Constr
$ctoConstr :: Error -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
Data)

data Files
    = Files { Files -> Maybe (String, Paragraph)
dsc :: Maybe (FilePath, Paragraph)
            , Files -> [(String, Paragraph)]
debs :: [(FilePath, Paragraph)]
            , Files -> Maybe String
tar :: Maybe FilePath
            , Files -> Maybe String
diff :: Maybe FilePath
            }

fakeChanges :: [FilePath] -> IO (FilePath, String)
fakeChanges :: [String] -> IO (String, String)
fakeChanges [String]
fps =
    do Files
files <- [String] -> IO Files
loadFiles [String]
fps
       let version :: String
version      = Files -> String
getVersion Files
files
           source :: String
source       = Files -> String
getSource Files
files
           maintainer :: String
maintainer   = Files -> String
getMaintainer Files
files
           arches :: [String]
arches       = Files -> [String]
getArches Files
files
           binArch :: String
binArch      = Files -> String
getBinArch Files
files
           dist :: String
dist         = String
"unstable"
           urgency :: String
urgency      = String
"low"
           ([String]
invalid, [(String, String, String)]
binaries) = forall a b. [Either a b] -> ([a], [b])
unzipEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Either String (String, String, String)
debNameSplit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (Files -> [(String, Paragraph)]
debs Files
files)
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [String]
invalid) (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Some .deb names are invalid: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
invalid)
       String
uploader <- IO String
getUploader
       String
date <- IO String
getCurrentLocalRFC822Time
       [String]
fileLines <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
mkFileLine [String]
fps
       let changes :: Control' String
changes = forall a. [Paragraph' a] -> Control' a
Control forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Field' a] -> Paragraph' a
Paragraph forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (a, a) -> Field' a
Field
               [ (String
"Format",String
" 1.7")
               , (String
"Date", Char
' ' forall a. a -> [a] -> [a]
: String
date)
               , (String
"Source", Char
' ' forall a. a -> [a] -> [a]
: String
source)
               , (String
"Binary", Char
' ' forall a. a -> [a] -> [a]
: (forall a. [a] -> [[a]] -> [a]
intercalate String
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,String
_,String
_) -> String
n) [(String, String, String)]
binaries))
               , (String
"Architecture", Char
' ' forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String]
arches)
               , (String
"Version", Char
' ' forall a. a -> [a] -> [a]
: String
version)
               , (String
"Distribution", Char
' ' forall a. a -> [a] -> [a]
: String
dist)
               , (String
"Urgency", Char
' ' forall a. a -> [a] -> [a]
: String
urgency)
               , (String
"Maintainer", Char
' ' forall a. a -> [a] -> [a]
: String
maintainer)
               , (String
"Changed-By", Char
' ' forall a. a -> [a] -> [a]
: String
uploader)
               , (String
"Description", String
"\n Simulated description")
               , (String
"Changes", String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'forall a. a -> [a] -> [a]
:) [ String
source forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
version forall a. [a] -> [a] -> [a]
++String
") " forall a. [a] -> [a] -> [a]
++ String
dist forall a. [a] -> [a] -> [a]
++ String
"; urgency=" forall a. [a] -> [a] -> [a]
++ String
urgency
                                                         , String
"."
                                                         , String
"  * Simulated changes"
                                                         ]
                                             ))
               , (String
"Files", String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
fileLines)
               ]
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
source, String
"_", String
version, String
"_", String
binArch, String
".changes"], forall a. Pretty a => a -> String
prettyShow Control' String
changes)
--       let (invalid, binaries) = unzipEithers $ map debNameSplit debs
{-
       when (not . null $ invalid) (throwDyn [MalformedDebFilename invalid])
       version <- getVersion dsc debs
       putStrLn version
       source <- getSource dsc debs
       putStrLn source
-}
-- TODO: seems like this could be more aggressive about ensure the
-- versions make sense. Except with packages like libc, the versions
-- don't make sense. Maybe we want a flag that disables version check
-- ?
getVersion :: Files -> String
getVersion :: Files -> String
getVersion Files
files
    | forall a. Maybe a -> Bool
isNothing (Files -> Maybe (String, Paragraph)
dsc Files
files) =
        let versions :: [Maybe String]
versions = forall a b. (a -> b) -> [a] -> [b]
map (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Version" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
        in
          if (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isJust [Maybe String]
versions) Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub [Maybe String]
versions) forall a. Eq a => a -> a -> Bool
== Int
1)
          then forall a. HasCallStack => Maybe a -> a
fromJust (forall a. [a] -> a
head [Maybe String]
versions)
          else forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show [[Maybe String] -> Error
VersionMismatch (forall a. Eq a => [a] -> [a]
nub [Maybe String]
versions)])
    | Bool
otherwise =
        case forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Version" (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Files -> Maybe (String, Paragraph)
dsc Files
files) of
          (Just String
v) -> String
v
          Maybe String
Nothing  -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"show (dsc files)" forall a. [a] -> [a] -> [a]
++ String
" does not have a Version field :("


getSource :: Files -> String
getSource :: Files -> String
getSource Files
files =
    let dscSource :: [String]
dscSource =
            case (Files -> Maybe (String, Paragraph)
dsc Files
files) of
              Maybe (String, Paragraph)
Nothing -> []
              (Just (String
fp, Paragraph
p)) ->
                  case forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Source" Paragraph
p of
                    (Just String
v) -> [String
v]
                    Maybe String
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
fp forall a. [a] -> [a] -> [a]
++ String
" does not have a Source field :("
        debSources :: [String]
debSources = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. ControlFunctions a => (String, Paragraph' a) -> a
debSource (Files -> [(String, Paragraph)]
debs Files
files)
        srcs :: [String]
srcs = forall a. Eq a => [a] -> [a]
nub ([String]
dscSource forall a. [a] -> [a] -> [a]
++ [String]
debSources)
    in
      if (forall a. [a] -> Bool
singleton [String]
srcs)
         then (forall a. [a] -> a
head [String]
srcs)
         else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not determine source."
    where
      debSource :: (String, Paragraph' a) -> a
debSource (String
deb,Paragraph' a
p) =
          case (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Source" Paragraph' a
p) of
            (Just a
v) -> a
v
            Maybe a
Nothing ->
                case forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Package" Paragraph' a
p of
                  (Just a
v) -> a
v
                  Maybe a
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not find Source or Package field in " forall a. [a] -> [a] -> [a]
++ String
deb



getMaintainer :: Files -> String
getMaintainer :: Files -> String
getMaintainer Files
files
    | forall a. Maybe a -> Bool
isJust (Files -> Maybe (String, Paragraph)
dsc Files
files) =
        let (String
fp, Paragraph
p) = forall a. HasCallStack => Maybe a -> a
fromJust (Files -> Maybe (String, Paragraph)
dsc Files
files)
        in
          case forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Maintainer" Paragraph
p of
            Maybe String
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
fp forall a. [a] -> [a] -> [a]
++ String
" is missing the Maintainer field."
            (Just String
v) -> String
v
    | Bool
otherwise =
        let maintainers :: [String]
maintainers = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Maintainer" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
            maintainer :: [String]
maintainer = forall a. Eq a => [a] -> [a]
nub [String]
maintainers
        in
          if forall a. [a] -> Bool
singleton [String]
maintainer
             then forall a. [a] -> a
head [String]
maintainer
             else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not uniquely determine the maintainer: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
maintainer

getArches :: Files -> [String]
getArches :: Files -> [String]
getArches Files
files =
    let debArchs :: [Maybe String]
debArchs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Architecture" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
        tarArch :: Maybe String
tarArch  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"source") (Files -> Maybe String
tar Files
files)
        diffArch :: Maybe String
diffArch = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const String
"source") (Files -> Maybe String
diff Files
files)
    in
      forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes (Maybe String
tarArch forall a. a -> [a] -> [a]
: Maybe String
diffArch forall a. a -> [a] -> [a]
: [Maybe String]
debArchs)


getBinArch :: Files -> String
getBinArch :: Files -> String
getBinArch Files
files =
    let binArch :: [String]
binArch = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Architecture" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Files -> [(String, Paragraph)]
debs Files
files)
    in
      if forall a. [a] -> Bool
singleton [String]
binArch
         then forall a. [a] -> a
head [String]
binArch
         else case (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
"all") [String]
binArch) of
                [String
b] -> String
b
                [String]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not uniquely determine binary architecture: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
binArch

mkFileLine :: FilePath -> IO String
mkFileLine :: String -> IO String
mkFileLine String
fp
    | String
".deb" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
fp =
        do String
sum <- String -> IO ByteString
L.readFile String
fp 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. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
           FileOffset
size <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FileStatus -> FileOffset
fileSize forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
fp
           (Control (Paragraph
p:[Paragraph]
_)) <- forall a. ControlFunctions a => String -> IO (Control' a)
Deb.fields String
fp
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
" ", String
sum, String
" ", forall a. Show a => a -> String
show FileOffset
size, String
" ", forall a. a -> Maybe a -> a
fromMaybe String
"unknown" (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Section" Paragraph
p), String
" "
                           , forall a. a -> Maybe a -> a
fromMaybe String
"optional" (forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Priority" Paragraph
p), String
" ", (ShowS
takeBaseName String
fp)
                           ]
    | Bool
otherwise =
        do String
sum <- String -> IO ByteString
L.readFile String
fp 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. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
           FileOffset
size <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FileStatus -> FileOffset
fileSize forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getFileStatus String
fp
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
" ", String
sum, String
" ", forall a. Show a => a -> String
show FileOffset
size, String
" ", String
"unknown", String
" "
                           , String
"optional",String
" ", (ShowS
takeBaseName String
fp)
                           ]

-- more implementations can be found at:
-- http://www.google.com/codesearch?hl=en&lr=&q=%22%5BEither+a+b%5D+-%3E+%28%5Ba%5D%2C%5Bb%5D%29%22&btnG=Search
unzipEithers :: [Either a b] -> ([a],[b])
unzipEithers :: forall a b. [Either a b] -> ([a], [b])
unzipEithers = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. Either a a -> ([a], [a]) -> ([a], [a])
unzipEither ([],[])
    where
      unzipEither :: Either a a -> ([a], [a]) -> ([a], [a])
unzipEither (Left a
l) ~([a]
ls, [a]
rs) = (a
lforall a. a -> [a] -> [a]
:[a]
ls, [a]
rs)
      unzipEither (Right a
r) ~([a]
ls, [a]
rs) = ([a]
ls, a
rforall a. a -> [a] -> [a]
:[a]
rs)

-- move to different library
debNameSplit :: String -> Either FilePath (String, String, String)
debNameSplit :: String -> Either String (String, String, String)
debNameSplit String
fp =
    case (ShowS
takeFileName String
fp) forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^(.*)_(.*)_(.*).deb$" of
      [[String
_, String
name, String
version, String
arch]] -> forall a b. b -> Either a b
Right (String
name, String
version, String
arch)
      [[String]]
_ -> forall a b. a -> Either a b
Left String
fp


loadFiles :: [FilePath] -> IO Files
loadFiles :: [String] -> IO Files
loadFiles [String]
files =
       let ([String]
dscs', [String]
files'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".dsc") [String]
files'
           ([String]
debs', [String]
files') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".deb") [String]
files
           ([String]
tars', [String]
files''') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".tar.gz") [String]
files''
           ([String]
diffs', [String]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".diff.gz") [String]
files'''
           errors :: [Error]
errors = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
debs'  forall a. Ord a => a -> a -> Bool
< Int
1) then [Error
NoDebs] else []
                           , if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dscs'  forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyDscs [String]
dscs']   else []
                           , if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
tars'  forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyTars [String]
tars']   else []
                           , if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
diffs' forall a. Ord a => a -> a -> Bool
> Int
1) then [[String] -> Error
TooManyDiffs [String]
diffs'] else []
                           , if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rest  forall a. Ord a => a -> a -> Bool
> Int
0) then [[String] -> Error
UnknownFiles [String]
rest]  else []
                           ]
       in
         do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Error]
errors) (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show [Error]
errors)
            Maybe (String, Paragraph)
dsc' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, Paragraph)
loadDsc (forall a. [a] -> Maybe a
listToMaybe [String]
dscs')
            [(String, Paragraph)]
debs'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, Paragraph)
loadDeb [String]
debs'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Files { dsc :: Maybe (String, Paragraph)
dsc = Maybe (String, Paragraph)
dsc', debs :: [(String, Paragraph)]
debs = [(String, Paragraph)]
debs'', tar :: Maybe String
tar = forall a. [a] -> Maybe a
listToMaybe [String]
tars', diff :: Maybe String
diff = forall a. [a] -> Maybe a
listToMaybe [String]
diffs' }
         -- if (not . null $ errors) then throwDyn errors else return (debs, listToMaybe dscs, listToMaybe tars, listToMaybe diffs)
    where
      loadDsc :: FilePath -> IO (FilePath, Paragraph)
      loadDsc :: String -> IO (String, Paragraph)
loadDsc String
dsc' =
          do Either ParseError (Control' String)
res <- forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
dsc'
             case  Either ParseError (Control' String)
res of
               (Left ParseError
e) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error parsing " forall a. [a] -> [a] -> [a]
++ String
dsc' forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
e
               (Right (Control [Paragraph
p])) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
dsc', Paragraph
p)
               (Right Control' String
c) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
dsc' forall a. [a] -> [a] -> [a]
++ String
" did not have exactly one paragraph: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Control' String
c
      loadDeb :: FilePath -> IO (FilePath, Paragraph)
      loadDeb :: String -> IO (String, Paragraph)
loadDeb String
deb =
          do Control' String
res <- forall a. ControlFunctions a => String -> IO (Control' a)
Deb.fields String
deb
             case Control' String
res of
               (Control [Paragraph
p]) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
deb, Paragraph
p)
               Control' String
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
deb forall a. [a] -> [a] -> [a]
++ String
" did not have exactly one paragraph: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Control' String
res


getUploader :: IO String
getUploader :: IO String
getUploader =
    do String
debFullName <-
           do Either SomeException String
dfn <- forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"DEBFULLNAME")
              case Either SomeException String
dfn of
                (Right String
n) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
n
                (Left (SomeException
_ :: SomeException)) ->
                    do Either SomeException String
dfn' <-forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"USER")
                       case Either SomeException String
dfn' of
                         (Right String
n) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
n
                         (Left (SomeException
_ :: SomeException)) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not determine user name, neither DEBFULLNAME nor USER enviroment variables were set."
       String
emailAddr <-
           do Either SomeException String
eml <- forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"DEBEMAIL")
              case Either SomeException String
eml of
                (Right String
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
e
                (Left (SomeException
_ :: SomeException)) ->
                    do Either SomeException String
eml' <- forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
getEnv String
"EMAIL")
                       case Either SomeException String
eml' of
                         (Right String
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
e
                         (Left (SomeException
_ :: SomeException)) -> IO String
getHostName -- FIXME: this is not a FQDN
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
debFullName forall a. [a] -> [a] -> [a]
++ String
" <" forall a. [a] -> [a] -> [a]
++ String
emailAddr forall a. [a] -> [a] -> [a]
++ String
">"

-- * Utils

singleton :: [a] -> Bool
singleton :: forall a. [a] -> Bool
singleton [a
_] = Bool
True
singleton [a]
_ = Bool
False