-- | Read an existing Debianization from a directory file.
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Debian.Debianize.InputDebian
    ( inputDebianization
    , inputDebianizationFile
    , inputChangeLog
    , loadChangeLog
    , dataDest
    , dataTop
    ) where

import Debug.Trace
import Control.Lens
import Control.Monad (filterM)
import Control.Monad.State (put)
import Control.Monad.Trans (liftIO, MonadIO)
import Data.Char (isSpace)
import Data.Map as Map (insert, insertWith)
import Data.Maybe (fromMaybe)
import Data.Set as Set (fromList, insert, singleton)
import Data.Text (break, lines, null, pack, strip, Text, unpack, words)
import Data.Text.IO (readFile)
import Debian.Changes (ChangeLog, parseChangeLog)
import Debian.Control (Control'(unControl), ControlFunctions, Field, Field'(..), Paragraph'(..), parseControlFromFile, stripWS)
import Debian.Debianize.DebInfo (changelog, compat, control, copyright, install, installDir, installInit, intermediateFiles, link, logrotateStanza, postInst, postRm, preInst, preRm, rulesHead, sourceFormat, warning, watch)
import qualified Debian.Debianize.DebInfo as T (flags, makeDebInfo)
import Debian.Debianize.Monad (CabalT, DebianT)
import Debian.Debianize.CabalInfo (packageDescription)
import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, newBinaryDebDescription)
import qualified Debian.Debianize.BinaryDebDescription as B (architecture, binaryPriority, multiArch, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, preDepends, provides, recommends, relations, replaces, suggests)
import Debian.Debianize.CopyrightDescription (readCopyrightDescription)
import Debian.Debianize.Prelude (getDirectoryContents', read', readFileMaybe, (.?=))
import qualified Debian.Debianize.SourceDebDescription as S (binaryPackages, buildConflicts, buildConflictsIndep, buildDepends, buildDependsIndep, dmUploadAllowed, homepage, newSourceDebDescription', priority, rulesRequiresRoot, section, SourceDebDescription, standardsVersion, uploaders, xDescription, vcsFields, VersionControlSpec(VCSArch, VCSBrowser, VCSBzr, VCSCvs, VCSDarcs, VCSGit, VCSHg, VCSMtn, VCSSvn), XField(XField), xFields)
import Debian.Orphans ()
import Debian.Policy (parseMaintainer, parsePackageArchitectures, parseStandardsVersion, parseUploaders, readPriority, readSection, readMultiArch, readSourceFormat, Section(..))
import Debian.Relation (BinPkgName(..), parseRelations, Relations, SrcPkgName(..))
--import Debug.Trace (trace)
import Distribution.Package (PackageIdentifier(..), unPackageName)
import qualified Distribution.PackageDescription as Cabal (dataDir, PackageDescription(package))
import Prelude hiding (break, lines, log, null, readFile, sum, words)
import System.Directory (doesFileExist)
import System.FilePath ((</>), dropExtension, takeExtension)
import System.IO.Error (catchIOError, isDoesNotExistError, tryIOError)
-- import System.Unix.Chroot (useEnv)
-- import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)

inputDebianization :: MonadIO m => DebianT m ()
inputDebianization :: forall (m :: * -> *). MonadIO m => DebianT m ()
inputDebianization =
    do -- Erase any the existing information
       Flags
fs <- Getting Flags DebInfo Flags -> StateT DebInfo m Flags
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Flags DebInfo Flags
Lens' DebInfo Flags
T.flags
       DebInfo -> DebianT m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (DebInfo -> DebianT m ()) -> DebInfo -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ Flags -> DebInfo
T.makeDebInfo Flags
fs
       (SourceDebDescription
ctl, [Field]
_) <- DebianT m (SourceDebDescription, [Field])
forall (m :: * -> *).
MonadIO m =>
DebianT m (SourceDebDescription, [Field])
inputSourceDebDescription
       DebianT m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory
       (SourceDebDescription -> Identity SourceDebDescription)
-> DebInfo -> Identity DebInfo
Lens' DebInfo SourceDebDescription
control ((SourceDebDescription -> Identity SourceDebDescription)
 -> DebInfo -> Identity DebInfo)
-> SourceDebDescription -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SourceDebDescription
ctl

-- | Try to input a file and if successful add it to the
-- debianization's list of "intermediate" files, files which will
-- simply be added to the final debianization without any
-- understanding of their contents or purpose.
inputDebianizationFile :: MonadIO m => FilePath -> DebianT m ()
inputDebianizationFile :: forall (m :: * -> *). MonadIO m => String -> DebianT m ()
inputDebianizationFile String
path =
    do DebianT m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory
       IO (Maybe Text) -> StateT DebInfo m (Maybe Text)
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe Text)
readFileMaybe String
path) StateT DebInfo m (Maybe Text)
-> (Maybe Text -> DebianT m ()) -> DebianT m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DebianT m ()
-> (Text -> DebianT m ()) -> Maybe Text -> DebianT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> DebianT m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\ Text
text -> (Set (String, Text) -> Identity (Set (String, Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Set (String, Text))
intermediateFiles ((Set (String, Text) -> Identity (Set (String, Text)))
 -> DebInfo -> Identity DebInfo)
-> (Set (String, Text) -> Set (String, Text)) -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (String, Text) -> Set (String, Text) -> Set (String, Text)
forall a. Ord a => a -> Set a -> Set a
Set.insert (String
path, Text
text))

inputSourceDebDescription :: MonadIO m => DebianT m (S.SourceDebDescription, [Field])
inputSourceDebDescription :: forall (m :: * -> *).
MonadIO m =>
DebianT m (SourceDebDescription, [Field])
inputSourceDebDescription =
    do [Paragraph' String]
paras <- IO [Paragraph' String] -> StateT DebInfo m [Paragraph' String]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Paragraph' String] -> StateT DebInfo m [Paragraph' String])
-> IO [Paragraph' String] -> StateT DebInfo m [Paragraph' String]
forall a b. (a -> b) -> a -> b
$ String -> IO (Either ParseError (Control' String))
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
"debian/control" IO (Either ParseError (Control' String))
-> (Either ParseError (Control' String) -> IO [Paragraph' String])
-> IO [Paragraph' String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseError -> IO [Paragraph' String])
-> (Control' String -> IO [Paragraph' String])
-> Either ParseError (Control' String)
-> IO [Paragraph' String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO [Paragraph' String]
forall a. HasCallStack => String -> a
error (String -> IO [Paragraph' String])
-> (ParseError -> String) -> ParseError -> IO [Paragraph' String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) ([Paragraph' String] -> IO [Paragraph' String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph' String] -> IO [Paragraph' String])
-> (Control' String -> [Paragraph' String])
-> Control' String
-> IO [Paragraph' String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control' String -> [Paragraph' String]
forall a. Control' a -> [Paragraph' a]
unControl)
       case [Paragraph' String]
paras of
         [] -> String -> DebianT m (SourceDebDescription, [Field])
forall a. HasCallStack => String -> a
error String
"Missing source paragraph"
         [Paragraph' String
_] -> String -> DebianT m (SourceDebDescription, [Field])
forall a. HasCallStack => String -> a
error String
"Missing binary paragraph"
         (Paragraph' String
hd : [Paragraph' String]
tl) -> (SourceDebDescription, [Field])
-> DebianT m (SourceDebDescription, [Field])
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourceDebDescription, [Field])
 -> DebianT m (SourceDebDescription, [Field]))
-> (SourceDebDescription, [Field])
-> DebianT m (SourceDebDescription, [Field])
forall a b. (a -> b) -> a -> b
$ Paragraph' String
-> [Paragraph' String] -> (SourceDebDescription, [Field])
parseSourceDebDescription Paragraph' String
hd [Paragraph' String]
tl

parseSourceDebDescription :: Paragraph' String -> [Paragraph' String] -> (S.SourceDebDescription, [Field])
parseSourceDebDescription :: Paragraph' String
-> [Paragraph' String] -> (SourceDebDescription, [Field])
parseSourceDebDescription (Paragraph [Field]
fields) [Paragraph' String]
binaryParagraphs =
    (Field
 -> (SourceDebDescription, [Field])
 -> (SourceDebDescription, [Field]))
-> (SourceDebDescription, [Field])
-> [Field]
-> (SourceDebDescription, [Field])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field
-> (SourceDebDescription, [Field])
-> (SourceDebDescription, [Field])
readField (SourceDebDescription
src, []) [Field]
fields'
    where
      fields' :: [Field]
fields' = (Field -> Field) -> [Field] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map Field -> Field
forall a. ControlFunctions a => Field' a -> Field' a
stripField [Field]
fields
      src :: SourceDebDescription
src = ASetter
  SourceDebDescription
  SourceDebDescription
  [BinaryDebDescription]
  [BinaryDebDescription]
-> [BinaryDebDescription]
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription
  SourceDebDescription
  [BinaryDebDescription]
  [BinaryDebDescription]
Lens' SourceDebDescription [BinaryDebDescription]
S.binaryPackages [BinaryDebDescription]
bins (SrcPkgName -> NameAddr -> SourceDebDescription
S.newSourceDebDescription' SrcPkgName
findSource NameAddr
findMaint)
      findSource :: SrcPkgName
findSource = String -> (String -> SrcPkgName) -> [Field] -> SrcPkgName
forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Source" String -> SrcPkgName
SrcPkgName [Field]
fields'
      findMaint :: NameAddr
findMaint = String -> (String -> NameAddr) -> [Field] -> NameAddr
forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Maintainer" (\ String
m -> (String -> NameAddr)
-> (NameAddr -> NameAddr) -> Either String NameAddr -> NameAddr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ String
e -> String -> NameAddr
forall a. HasCallStack => String -> a
error (String -> NameAddr) -> String -> NameAddr
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse maintainer field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e) NameAddr -> NameAddr
forall a. a -> a
id (Either String NameAddr -> NameAddr)
-> (String -> Either String NameAddr) -> String -> NameAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String NameAddr
parseMaintainer (String -> NameAddr) -> String -> NameAddr
forall a b. (a -> b) -> a -> b
$ String
m) [Field]
fields'
      -- findStandards = findMap "Standards-Version" parseStandardsVersion fields'

      ([BinaryDebDescription]
bins, [[Field]]
_extra) = [(BinaryDebDescription, [Field])]
-> ([BinaryDebDescription], [[Field]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(BinaryDebDescription, [Field])]
 -> ([BinaryDebDescription], [[Field]]))
-> [(BinaryDebDescription, [Field])]
-> ([BinaryDebDescription], [[Field]])
forall a b. (a -> b) -> a -> b
$ (Paragraph' String -> (BinaryDebDescription, [Field]))
-> [Paragraph' String] -> [(BinaryDebDescription, [Field])]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph' String -> (BinaryDebDescription, [Field])
parseBinaryDebDescription [Paragraph' String]
binaryParagraphs
      readField :: Field -> (S.SourceDebDescription, [Field]) -> (S.SourceDebDescription, [Field])
      -- Mandatory
      readField :: Field
-> (SourceDebDescription, [Field])
-> (SourceDebDescription, [Field])
readField (Field (String
"Source", String
_)) (SourceDebDescription, [Field])
x = (SourceDebDescription, [Field])
x
      readField (Field (String
"Maintainer", String
_)) (SourceDebDescription, [Field])
x = (SourceDebDescription, [Field])
x
      -- readField (Field ("Standards-Version", _)) x = x
      -- Recommended
      readField (Field (String
"Standards-Version", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe StandardsVersion)
  (Maybe StandardsVersion)
-> Maybe StandardsVersion
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe StandardsVersion)
  (Maybe StandardsVersion)
Lens' SourceDebDescription (Maybe StandardsVersion)
S.standardsVersion (StandardsVersion -> Maybe StandardsVersion
forall a. a -> Maybe a
Just (String -> StandardsVersion
parseStandardsVersion String
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Priority", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe PackagePriority)
  (Maybe PackagePriority)
-> Maybe PackagePriority
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe PackagePriority)
  (Maybe PackagePriority)
Lens' SourceDebDescription (Maybe PackagePriority)
S.priority (PackagePriority -> Maybe PackagePriority
forall a. a -> Maybe a
Just (String -> PackagePriority
readPriority String
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Section", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe Section)
  (Maybe Section)
-> Maybe Section -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription
  SourceDebDescription
  (Maybe Section)
  (Maybe Section)
Lens' SourceDebDescription (Maybe Section)
S.section (Section -> Maybe Section
forall a. a -> Maybe a
Just (String -> Section
MainSection String
value)) SourceDebDescription
desc, [Field]
unrecognized)
      -- Optional
      readField (Field (String
"Homepage", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription (Maybe Text) (Maybe Text)
-> Maybe Text -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription (Maybe Text) (Maybe Text)
Lens' SourceDebDescription (Maybe Text)
S.homepage (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
strip (String -> Text
pack String
value))) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Uploaders", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription [NameAddr] [NameAddr]
-> [NameAddr] -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription [NameAddr] [NameAddr]
Lens' SourceDebDescription [NameAddr]
S.uploaders ((String -> [NameAddr])
-> ([NameAddr] -> [NameAddr])
-> Either String [NameAddr]
-> [NameAddr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([NameAddr] -> String -> [NameAddr]
forall a b. a -> b -> a
const []) [NameAddr] -> [NameAddr]
forall a. a -> a
id (String -> Either String [NameAddr]
parseUploaders String
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"DM-Upload-Allowed", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter SourceDebDescription SourceDebDescription Bool Bool
-> Bool -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SourceDebDescription SourceDebDescription Bool Bool
Lens' SourceDebDescription Bool
S.dmUploadAllowed (String -> Bool
yes String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Build-Depends", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription Relations Relations
-> Relations -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription Relations Relations
Lens' SourceDebDescription Relations
S.buildDepends (String -> Relations
rels String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Build-Conflicts", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription Relations Relations
-> Relations -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription Relations Relations
Lens' SourceDebDescription Relations
S.buildConflicts (String -> Relations
rels String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Build-Depends-Indep", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription Relations Relations
-> Relations -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription Relations Relations
Lens' SourceDebDescription Relations
S.buildDependsIndep (String -> Relations
rels String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Build-Conflicts-Indep", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription Relations Relations
-> Relations -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription Relations Relations
Lens' SourceDebDescription Relations
S.buildConflictsIndep (String -> Relations
rels String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Rules-Requires-Root", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter SourceDebDescription SourceDebDescription Bool Bool
-> Bool -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SourceDebDescription SourceDebDescription Bool Bool
Lens' SourceDebDescription Bool
S.rulesRequiresRoot (String -> Bool
yes String
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Browser", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSBrowser (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Arch", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSArch (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Bzr", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSBzr (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Cvs", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSCvs (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Darcs", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSDarcs (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Git", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSGit (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Hg", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSHg (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Mtn", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSMtn (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Vcs-Svn", String
s)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
-> (Set VersionControlSpec -> Set VersionControlSpec)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription
  SourceDebDescription
  (Set VersionControlSpec)
  (Set VersionControlSpec)
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> VersionControlSpec
-> Set VersionControlSpec -> Set VersionControlSpec
forall a. Ord a => a -> Set a -> Set a
Set.insert (Text -> VersionControlSpec
S.VCSSvn (String -> Text
pack String
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"X-Description", String
value)) (SourceDebDescription
desc, [Field]
unrecognized) = (ASetter
  SourceDebDescription SourceDebDescription (Maybe Text) (Maybe Text)
-> Maybe Text -> SourceDebDescription -> SourceDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  SourceDebDescription SourceDebDescription (Maybe Text) (Maybe Text)
Lens' SourceDebDescription (Maybe Text)
S.xDescription (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
pack String
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField field :: Field
field@(Field (Char
'X' : String
fld, String
value)) (SourceDebDescription
desc, [Field]
unrecognized) =
          case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"BCS") String
fld of
            (String
xs, Char
'-' : String
more) -> (ASetter
  SourceDebDescription SourceDebDescription (Set XField) (Set XField)
-> (Set XField -> Set XField)
-> SourceDebDescription
-> SourceDebDescription
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SourceDebDescription SourceDebDescription (Set XField) (Set XField)
Lens' SourceDebDescription (Set XField)
S.xFields (\ Set XField
xFields -> XField -> Set XField -> Set XField
forall a. Ord a => a -> Set a -> Set a
Set.insert (Set XFieldDest -> Text -> Text -> XField
S.XField ([XFieldDest] -> Set XFieldDest
forall a. Ord a => [a] -> Set a
fromList ((Char -> XFieldDest) -> String -> [XFieldDest]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> XFieldDest) -> String -> XFieldDest
forall a. Read a => (String -> a) -> String -> a
read' (\ String
s -> String -> XFieldDest
forall a. HasCallStack => String -> a
error (String -> XFieldDest) -> String -> XFieldDest
forall a b. (a -> b) -> a -> b
$ String
"parseSourceDebDescription: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s) (String -> XFieldDest) -> (Char -> String) -> Char -> XFieldDest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: [])) String
xs)) (String -> Text
pack String
more) (String -> Text
pack String
value)) Set XField
xFields) SourceDebDescription
desc, [Field]
unrecognized)
            (String, String)
_ -> (SourceDebDescription
desc, Field
field Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
unrecognized)
      readField Field
field (SourceDebDescription
desc, [Field]
unrecognized) = (SourceDebDescription
desc, Field
field Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
unrecognized)

parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])
parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])
parseBinaryDebDescription (Paragraph [Field]
fields) =
    (Field
 -> (BinaryDebDescription, [Field])
 -> (BinaryDebDescription, [Field]))
-> (BinaryDebDescription, [Field])
-> [Field]
-> (BinaryDebDescription, [Field])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field
-> (BinaryDebDescription, [Field])
-> (BinaryDebDescription, [Field])
readField (BinaryDebDescription
bin, []) [Field]
fields'
    where
      fields' :: [Field]
fields' = (Field -> Field) -> [Field] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map Field -> Field
forall a. ControlFunctions a => Field' a -> Field' a
stripField [Field]
fields
      bin :: BinaryDebDescription
bin = ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackageArchitectures)
  (Maybe PackageArchitectures)
-> Maybe PackageArchitectures
-> BinaryDebDescription
-> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackageArchitectures)
  (Maybe PackageArchitectures)
Lens' BinaryDebDescription (Maybe PackageArchitectures)
B.architecture (PackageArchitectures -> Maybe PackageArchitectures
forall a. a -> Maybe a
Just PackageArchitectures
arch) (BinPkgName -> BinaryDebDescription
newBinaryDebDescription BinPkgName
b)
      b :: BinPkgName
      b :: BinPkgName
b = String -> (String -> BinPkgName) -> [Field] -> BinPkgName
forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Package" String -> BinPkgName
BinPkgName [Field]
fields'
      arch :: PackageArchitectures
arch = String
-> (String -> PackageArchitectures)
-> [Field]
-> PackageArchitectures
forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Architecture" String -> PackageArchitectures
parsePackageArchitectures [Field]
fields'
{-
(BinPkgName (fromJust (fieldValue "Package" bin)))
(read' (fromJust (fieldValue "Architecture" bin)))
, []
    foldr readField (newBinaryDebDescription (BinPkgName (fromJust (fieldValue "Package" bin))) (read' (fromJust (fieldValue "Architecture" bin))), []) (map stripField fields)
-}

      readField :: Field -> (BinaryDebDescription, [Field]) -> (BinaryDebDescription, [Field])
      readField :: Field
-> (BinaryDebDescription, [Field])
-> (BinaryDebDescription, [Field])
readField (Field (String
"Package", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription BinPkgName BinPkgName
-> BinPkgName -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription BinaryDebDescription BinPkgName BinPkgName
Lens' BinaryDebDescription BinPkgName
B.package (String -> BinPkgName
BinPkgName String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Architecture", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackageArchitectures)
  (Maybe PackageArchitectures)
-> Maybe PackageArchitectures
-> BinaryDebDescription
-> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackageArchitectures)
  (Maybe PackageArchitectures)
Lens' BinaryDebDescription (Maybe PackageArchitectures)
B.architecture (PackageArchitectures -> Maybe PackageArchitectures
forall a. a -> Maybe a
Just (String -> PackageArchitectures
parsePackageArchitectures String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Multi-Arch", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe MultiArch)
  (Maybe MultiArch)
-> Maybe MultiArch -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe MultiArch)
  (Maybe MultiArch)
Lens' BinaryDebDescription (Maybe MultiArch)
B.multiArch (MultiArch -> Maybe MultiArch
forall a. a -> Maybe a
Just (String -> MultiArch
readMultiArch String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Section", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe Section)
  (Maybe Section)
-> Maybe Section -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe Section)
  (Maybe Section)
Lens' BinaryDebDescription (Maybe Section)
B.binarySection (Section -> Maybe Section
forall a. a -> Maybe a
Just (String -> Section
readSection String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Priority", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackagePriority)
  (Maybe PackagePriority)
-> Maybe PackagePriority
-> BinaryDebDescription
-> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription
  BinaryDebDescription
  (Maybe PackagePriority)
  (Maybe PackagePriority)
Lens' BinaryDebDescription (Maybe PackagePriority)
B.binaryPriority (PackagePriority -> Maybe PackagePriority
forall a. a -> Maybe a
Just (String -> PackagePriority
readPriority String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Essential", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription (Maybe Bool) (Maybe Bool)
-> Maybe Bool -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription BinaryDebDescription (Maybe Bool) (Maybe Bool)
Lens' BinaryDebDescription (Maybe Bool)
B.essential (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (String -> Bool
yes String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Depends", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.depends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Recommends", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.recommends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Suggests", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.suggests) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Pre-Depends", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.preDepends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Breaks", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.breaks) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Conflicts", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.conflicts) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Provides", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.provides) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Replaces", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.replaces) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Built-Using", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription Relations Relations
-> Relations -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ((PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> ASetter
     BinaryDebDescription BinaryDebDescription Relations Relations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.builtUsing) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Description", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (ASetter
  BinaryDebDescription BinaryDebDescription (Maybe Text) (Maybe Text)
-> Maybe Text -> BinaryDebDescription -> BinaryDebDescription
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  BinaryDebDescription BinaryDebDescription (Maybe Text) (Maybe Text)
Lens' BinaryDebDescription (Maybe Text)
B.description (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
pack String
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField Field
field (BinaryDebDescription
desc, [Field]
unrecognized) = (BinaryDebDescription
desc, Field
field Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: [Field]
unrecognized)

-- | Look for a field and apply a function to its value
findMap :: String -> (String -> a) -> [Field] -> a
findMap :: forall a. String -> (String -> a) -> [Field] -> a
findMap String
field String -> a
f [Field]
fields =
    a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" field in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Field] -> String
forall a. Show a => a -> String
show [Field]
fields) ((Field -> Maybe a -> Maybe a) -> Maybe a -> [Field] -> Maybe a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field -> Maybe a -> Maybe a
findMap' Maybe a
forall a. Maybe a
Nothing [Field]
fields)
    where
      findMap' :: Field -> Maybe a -> Maybe a
findMap' (Field (String
fld, String
val)) Maybe a
x = if String
fld String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
field then a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
f String
val) else Maybe a
x
      findMap' Field
_ Maybe a
x = Maybe a
x

stripField :: ControlFunctions a => Field' a -> Field' a
stripField :: forall a. ControlFunctions a => Field' a -> Field' a
stripField (Field (a
a, a
b)) = (a, a) -> Field' a
forall a. (a, a) -> Field' a
Field (a
a, a -> a
forall a. ControlFunctions a => a -> a
stripWS a
b)
stripField Field' a
x = Field' a
x

rels :: String -> Relations
rels :: String -> Relations
rels String
s =
    (ParseError -> Relations)
-> (Relations -> Relations)
-> Either ParseError Relations
-> Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ ParseError
e -> String -> Relations
forall a. HasCallStack => String -> a
error (String
"Relations field error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)) Relations -> Relations
forall a. a -> a
id (String -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations String
s)

yes :: String -> Bool
yes :: String -> Bool
yes String
"yes" = Bool
True
yes String
"no" = Bool
False
yes String
x = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Expecting yes or no: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

-- | Look in several places for a debian changelog
inputChangeLog :: MonadIO m => DebianT m ()
inputChangeLog :: forall (m :: * -> *). MonadIO m => DebianT m ()
inputChangeLog =
    do Maybe ChangeLog
log <- IO (Maybe ChangeLog) -> StateT DebInfo m (Maybe ChangeLog)
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ChangeLog)
loadChangeLog
       (Maybe ChangeLog -> f (Maybe ChangeLog)) -> DebInfo -> f DebInfo
Lens' DebInfo (Maybe ChangeLog)
changelog Lens' DebInfo (Maybe ChangeLog) -> Maybe ChangeLog -> DebianT m ()
forall (m :: * -> *) a b.
Monad m =>
Lens' a (Maybe b) -> Maybe b -> StateT a m ()
.?= Maybe ChangeLog
log

-- | Look in several places for a debian changelog
loadChangeLog :: IO (Maybe ChangeLog)
loadChangeLog :: IO (Maybe ChangeLog)
loadChangeLog =
    [String] -> IO (Maybe ChangeLog)
doPaths [String
"CHANGELOG", String
"ChangeLog", String
"changelog", String
"debian/changelog"]
    where
      doPaths :: [FilePath] -> IO (Maybe ChangeLog)
      doPaths :: [String] -> IO (Maybe ChangeLog)
doPaths (String
p : [String]
ps) = String -> IO (Maybe ChangeLog)
doPath String
p IO (Maybe ChangeLog)
-> (Maybe ChangeLog -> IO (Maybe ChangeLog))
-> IO (Maybe ChangeLog)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ChangeLog)
-> (ChangeLog -> IO (Maybe ChangeLog))
-> Maybe ChangeLog
-> IO (Maybe ChangeLog)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> IO (Maybe ChangeLog)
doPaths [String]
ps) (\ChangeLog
log -> {-putStrLn ("Found valid changelog at " ++ p) >>-} Maybe ChangeLog -> IO (Maybe ChangeLog)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeLog -> Maybe ChangeLog
forall a. a -> Maybe a
Just ChangeLog
log))
      doPaths [] = Maybe ChangeLog -> IO (Maybe ChangeLog)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChangeLog
forall a. Maybe a
Nothing
      doPath :: FilePath -> IO (Maybe ChangeLog)
      doPath :: String -> IO (Maybe ChangeLog)
doPath String
p = do
        Either IOError Text
t <- IO Text -> IO (Either IOError Text)
forall a. IO a -> IO (Either IOError a)
tryIOError (String -> IO Text
readFile String
p)
        (IOError -> IO (Maybe ChangeLog))
-> (Text -> IO (Maybe ChangeLog))
-> Either IOError Text
-> IO (Maybe ChangeLog)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> IO (Maybe ChangeLog)
doExn Text -> IO (Maybe ChangeLog)
doParse Either IOError Text
t
          where
            doParse :: Text -> IO (Maybe ChangeLog)
            doParse :: Text -> IO (Maybe ChangeLog)
doParse Text
t = do
              Maybe ChangeLog -> IO (Maybe ChangeLog)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChangeLog -> IO (Maybe ChangeLog))
-> Maybe ChangeLog -> IO (Maybe ChangeLog)
forall a b. (a -> b) -> a -> b
$ ([[String]] -> Maybe ChangeLog)
-> (ChangeLog -> Maybe ChangeLog)
-> Either [[String]] ChangeLog
-> Maybe ChangeLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ChangeLog -> [[String]] -> Maybe ChangeLog
forall a b. a -> b -> a
const Maybe ChangeLog
forall a. Maybe a
Nothing) ChangeLog -> Maybe ChangeLog
forall a. a -> Maybe a
Just (String -> Either [[String]] ChangeLog
parseChangeLog (Text -> String
unpack Text
t))
            doExn :: IOError -> IO (Maybe ChangeLog)
            doExn :: IOError -> IO (Maybe ChangeLog)
doExn IOError
e | IOError -> Bool
isDoesNotExistError IOError
e = Maybe ChangeLog -> IO (Maybe ChangeLog)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChangeLog
forall a. Maybe a
Nothing
            doExn IOError
e = String -> IO (Maybe ChangeLog)
forall a. HasCallStack => String -> a
error (String
"inputChangelog: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e)

inputCabalInfoFromDirectory :: MonadIO m => DebianT m () -- .install files, .init files, etc.
inputCabalInfoFromDirectory :: forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory =
    do DebianT m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
findChangeLog -- Look for changelog in unconventional locations
       DebianT m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
findFiles     -- If debian/changelog is found it will replace what we found above
       String -> DebianT m ()
forall (m :: * -> *). MonadIO m => String -> DebianT m ()
doFiles (String
"./debian/cabalInstall")
    where
      -- Find regular files in the debian/ or in debian/source/format/ and
      -- add them to the debianization.
      findFiles :: MonadIO m => DebianT m ()
      findFiles :: forall (m :: * -> *). MonadIO m => DebianT m ()
findFiles =
          IO [String] -> StateT DebInfo m [String]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
getDirectoryContents' (String
"debian")) StateT DebInfo m [String]
-> ([String] -> StateT DebInfo m [String])
-> StateT DebInfo m [String]
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          [String] -> StateT DebInfo m [String]
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> StateT DebInfo m [String])
-> ([String] -> [String]) -> [String] -> StateT DebInfo m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"source/format"]) StateT DebInfo m [String]
-> ([String] -> StateT DebInfo m [String])
-> StateT DebInfo m [String]
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          IO [String] -> StateT DebInfo m [String]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> StateT DebInfo m [String])
-> ([String] -> IO [String])
-> [String]
-> StateT DebInfo m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"debian") String -> String -> String
</>)) StateT DebInfo m [String]
-> ([String] -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [String]
names ->
          (String -> StateT DebInfo m ()) -> [String] -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> String -> StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => String -> String -> DebianT m ()
inputCabalInfo (String
"debian")) [String]
names
      findChangeLog :: MonadIO m => DebianT m ()
      findChangeLog :: forall (m :: * -> *). MonadIO m => DebianT m ()
findChangeLog =
          (String -> StateT DebInfo m Bool)
-> [String] -> StateT DebInfo m [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> StateT DebInfo m Bool
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT DebInfo m Bool)
-> (String -> IO Bool) -> String -> StateT DebInfo m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist) [String
"changelog", String
"ChangeLog", String
"CHANGELOG"] StateT DebInfo m [String]
-> ([String] -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String]
names ->
          (String -> StateT DebInfo m ()) -> [String] -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> String -> StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => String -> String -> DebianT m ()
inputCabalInfo String
".") [String]
names
      doFiles :: MonadIO m => FilePath -> DebianT m ()
      doFiles :: forall (m :: * -> *). MonadIO m => String -> DebianT m ()
doFiles String
tmp =
          do [String]
sums <- IO [String] -> StateT DebInfo m [String]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> StateT DebInfo m [String])
-> IO [String] -> StateT DebInfo m [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents' String
tmp IO [String] -> (IOError -> IO [String]) -> IO [String]
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\ IOError
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
             [String]
paths <- IO [String] -> StateT DebInfo m [String]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> StateT DebInfo m [String])
-> IO [String] -> StateT DebInfo m [String]
forall a b. (a -> b) -> a -> b
$ (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ String
sum -> String -> IO [String]
getDirectoryContents' (String
tmp String -> String -> String
</> String
sum) IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
sum String -> String -> String
</>)) [String]
sums IO [[String]] -> ([[String]] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> ([[String]] -> [String]) -> [[String]] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'~') (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
last) ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
             [Text]
files <- IO [Text] -> StateT DebInfo m [Text]
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> StateT DebInfo m [Text])
-> IO [Text] -> StateT DebInfo m [Text]
forall a b. (a -> b) -> a -> b
$ (String -> IO Text) -> [String] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> IO Text
readFile (String -> IO Text) -> (String -> String) -> String -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
tmp String -> String -> String
</>)) [String]
paths
             ((String, Text) -> DebianT m ())
-> [(String, Text)] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (String, Text)
x -> (Set (String, Text) -> Identity (Set (String, Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Set (String, Text))
intermediateFiles ((Set (String, Text) -> Identity (Set (String, Text)))
 -> DebInfo -> Identity DebInfo)
-> (Set (String, Text) -> Set (String, Text)) -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (String, Text) -> Set (String, Text) -> Set (String, Text)
forall a. Ord a => a -> Set a -> Set a
Set.insert (String, Text)
x) ([String] -> [Text] -> [(String, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"debian/cabalInstall" String -> String -> String
</>) [String]
paths) [Text]
files)

-- | Construct a file path from the debian directory and a relative
-- path, read its contents and add the result to the debianization.
-- This may mean using a specialized parser from the debian package
-- (e.g. parseChangeLog), and some files (like control) are ignored
-- here, though I don't recall why at the moment.
inputCabalInfo :: MonadIO m => FilePath -> FilePath -> DebianT m ()
inputCabalInfo :: forall (m :: * -> *). MonadIO m => String -> String -> DebianT m ()
inputCabalInfo String
_ String
path | String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
path [String
"control"] = () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
inputCabalInfo String
debian name :: String
name@String
"source/format" = IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> StateT DebInfo m ())
-> (SourceFormat -> StateT DebInfo m ())
-> Either Text SourceFormat
-> StateT DebInfo m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ Text
x -> (Set Text -> Identity (Set Text)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Text)
warning ((Set Text -> Identity (Set Text)) -> DebInfo -> Identity DebInfo)
-> (Set Text -> Set Text) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
x) (((SourceFormat -> Identity SourceFormat)
-> DebInfo -> Identity DebInfo
Lens' DebInfo SourceFormat
sourceFormat ((SourceFormat -> Identity SourceFormat)
 -> DebInfo -> Identity DebInfo)
-> SourceFormat -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)) (Text -> Either Text SourceFormat
readSourceFormat Text
text)
inputCabalInfo String
debian name :: String
name@String
"watch" = IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Maybe Text -> Identity (Maybe Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe Text)
watch ((Maybe Text -> Identity (Maybe Text))
 -> DebInfo -> Identity DebInfo)
-> Maybe Text -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
inputCabalInfo String
debian name :: String
name@String
"rules" = IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Maybe Text -> Identity (Maybe Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe Text)
rulesHead ((Maybe Text -> Identity (Maybe Text))
 -> DebInfo -> Identity DebInfo)
-> Maybe Text -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
"\n")
inputCabalInfo String
debian name :: String
name@String
"compat" = IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Maybe Int -> Identity (Maybe Int)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe Int)
compat ((Maybe Int -> Identity (Maybe Int))
 -> DebInfo -> Identity DebInfo)
-> Maybe Int -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Maybe Int
forall a. a -> Maybe a
Just ((String -> Int) -> String -> Int
forall a. Read a => (String -> a) -> String -> a
read' (\ String
s -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"compat: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s) (Text -> String
unpack Text
text))
inputCabalInfo String
debian name :: String
name@String
"copyright" = IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Maybe CopyrightDescription
 -> Identity (Maybe CopyrightDescription))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe CopyrightDescription)
copyright ((Maybe CopyrightDescription
  -> Identity (Maybe CopyrightDescription))
 -> DebInfo -> Identity DebInfo)
-> Maybe CopyrightDescription -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= CopyrightDescription -> Maybe CopyrightDescription
forall a. a -> Maybe a
Just (Text -> CopyrightDescription
readCopyrightDescription Text
text)
-- The normal position for a debian changelog is debian/changelog, but
-- we also look for it in changelog, ChangeLog, and CHANGELOG because
-- hackage looks for it in those places and the debianization is
-- better off with those entries than without.
inputCabalInfo String
debian name :: String
name@String
"changelog" = do
  Maybe ChangeLog
log <- IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m (Maybe ChangeLog))
-> StateT DebInfo m (Maybe ChangeLog)
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ChangeLog -> StateT DebInfo m (Maybe ChangeLog)
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChangeLog -> StateT DebInfo m (Maybe ChangeLog))
-> (Text -> Maybe ChangeLog)
-> Text
-> StateT DebInfo m (Maybe ChangeLog)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[String]] -> Maybe ChangeLog)
-> (ChangeLog -> Maybe ChangeLog)
-> Either [[String]] ChangeLog
-> Maybe ChangeLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ChangeLog -> [[String]] -> Maybe ChangeLog
forall a b. a -> b -> a
const Maybe ChangeLog
forall a. Maybe a
Nothing) ChangeLog -> Maybe ChangeLog
forall a. a -> Maybe a
Just (Either [[String]] ChangeLog -> Maybe ChangeLog)
-> (Text -> Either [[String]] ChangeLog) -> Text -> Maybe ChangeLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either [[String]] ChangeLog
parseChangeLog (String -> Either [[String]] ChangeLog)
-> (Text -> String) -> Text -> Either [[String]] ChangeLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  (Maybe ChangeLog -> Identity (Maybe ChangeLog))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe ChangeLog)
changelog ((Maybe ChangeLog -> Identity (Maybe ChangeLog))
 -> DebInfo -> Identity DebInfo)
-> Maybe ChangeLog -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ChangeLog
log
inputCabalInfo String
debian String
name =
    case (String -> BinPkgName
BinPkgName (String -> String
dropExtension String
name), String -> String
takeExtension String
name) of
      (BinPkgName
p, String
".install") ->   IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> StateT DebInfo m ()) -> [Text] -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> StateT DebInfo m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readInstall BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".dirs") ->      IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> StateT DebInfo m ()) -> [Text] -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> StateT DebInfo m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readDir BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".init") ->      IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
installInit ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".logrotate") -> IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName (Set Text) -> Identity (Map BinPkgName (Set Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName (Set Text))
logrotateStanza ((Map BinPkgName (Set Text)
  -> Identity (Map BinPkgName (Set Text)))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName (Set Text) -> Map BinPkgName (Set Text))
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Set Text -> Set Text -> Set Text)
-> BinPkgName
-> Set Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName (Set Text)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set Text -> Set Text -> Set Text
forall a. Monoid a => a -> a -> a
mappend BinPkgName
p (Text -> Set Text
forall a. a -> Set a
singleton Text
text)
      (BinPkgName
p, String
".links") ->     IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> StateT DebInfo m ()) -> [Text] -> StateT DebInfo m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> StateT DebInfo m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readLink BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".postinst") ->  IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
postInst ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".postrm") ->    IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
postRm ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".preinst") ->   IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
preInst ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".prerm") ->     IO Text -> StateT DebInfo m Text
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m ()) -> StateT DebInfo m ()
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
preRm ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
 -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
_, String
".log") ->       () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, String
".debhelper") -> () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, String
".hs") ->        () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Code that uses this library
      (BinPkgName
_, String
".setup") ->     () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Compiled Setup.hs file
      (BinPkgName
_, String
".substvars") -> () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Unsupported
      (BinPkgName
_, String
"") ->           () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- File with no extension
      (BinPkgName
_, String
x) | String -> Char
forall a. HasCallStack => [a] -> a
last String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' -> () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- backup file
      (BinPkgName, String)
_ -> IO () -> StateT DebInfo m ()
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Ignored debianization file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
debian String -> String -> String
</> String
name)

-- | Read a line from a debian .links file
readLink :: Monad m => BinPkgName -> Text -> DebianT m ()
readLink :: forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readLink BinPkgName
p Text
line =
    case Text -> [Text]
words Text
line of
      [Text
a, Text
b] -> BinPkgName -> String -> String -> DebianT m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> String -> String -> StateT DebInfo m ()
link BinPkgName
p (Text -> String
unpack Text
a) (Text -> String
unpack Text
b)
      [] -> () -> DebianT m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Text]
_ -> String -> DebianT m () -> DebianT m ()
forall a. String -> a -> a
trace (String
"Unexpected value passed to readLink: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
line) (() -> DebianT m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Read a line from a debian .install file
readInstall :: Monad m => BinPkgName -> Text -> DebianT m ()
readInstall :: forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readInstall BinPkgName
p Text
line =
    case (Char -> Bool) -> Text -> (Text, Text)
break Char -> Bool
isSpace Text
line of
      (Text
_, Text
b) | Text -> Bool
null Text
b -> String -> DebianT m ()
forall a. HasCallStack => String -> a
error (String -> DebianT m ()) -> String -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ String
"readInstall: syntax error in .install file for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BinPkgName -> String
forall a. Show a => a -> String
show BinPkgName
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
line
      (Text
a, Text
b) -> BinPkgName -> String -> String -> DebianT m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> String -> String -> StateT DebInfo m ()
install BinPkgName
p (Text -> String
unpack (Text -> Text
strip Text
a)) (Text -> String
unpack (Text -> Text
strip Text
b))

-- | Read a line from a debian .dirs file
readDir :: Monad m => BinPkgName -> Text -> DebianT m ()
readDir :: forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readDir BinPkgName
p Text
line = BinPkgName -> String -> StateT DebInfo m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> String -> StateT DebInfo m ()
installDir BinPkgName
p (Text -> String
unpack Text
line)

-- chroot :: NFData a => FilePath -> IO a -> IO a
-- chroot "/" task = task
-- chroot root task = useEnv root (return . force) task

-- | Where to put the installed data files.  Computes the destination
-- directory from a Cabal package description.  This needs to match
-- the path cabal assigns to datadir in the
-- dist/build/autogen/Paths_packagename.hs module, or perhaps the path
-- in the CABAL_DEBIAN_DATADIR environment variable.
dataDest :: Monad m => CabalT m FilePath
dataDest :: forall (m :: * -> *). Monad m => CabalT m String
dataDest = do
  PackageDescription
d <- Getting PackageDescription CabalInfo PackageDescription
-> StateT CabalInfo m PackageDescription
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting PackageDescription CabalInfo PackageDescription
Lens' CabalInfo PackageDescription
packageDescription
  String -> CabalT m String
forall a. a -> StateT CabalInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CabalT m String) -> String -> CabalT m String
forall a b. (a -> b) -> a -> b
$ String
"usr/share" String -> String -> String
</> (PackageName -> String
unPackageName (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> PackageIdentifier -> PackageName
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
Cabal.package PackageDescription
d)
-- | Where to look for the data-files
dataTop :: Monad m => CabalT m FilePath
dataTop :: forall (m :: * -> *). Monad m => CabalT m String
dataTop = do
  PackageDescription
d <- Getting PackageDescription CabalInfo PackageDescription
-> StateT CabalInfo m PackageDescription
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting PackageDescription CabalInfo PackageDescription
Lens' CabalInfo PackageDescription
packageDescription
  String -> CabalT m String
forall a. a -> StateT CabalInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CabalT m String) -> String -> CabalT m String
forall a b. (a -> b) -> a -> b
$ case PackageDescription -> String
Cabal.dataDir PackageDescription
d of
             String
"" -> String
"."
             String
x -> String
x