-- | 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.Monoid ((<>))
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, 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 :: 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 :: FilePath -> DebianT m ()
inputDebianizationFile FilePath
path =
    do DebianT m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory
       IO (Maybe Text) -> StateT DebInfo m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe Text)
readFileMaybe FilePath
path) StateT DebInfo m (Maybe Text)
-> (Maybe Text -> DebianT m ()) -> DebianT m ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()) (\ Text
text -> (Set (FilePath, Text) -> Identity (Set (FilePath, Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Set (FilePath, Text))
intermediateFiles ((Set (FilePath, Text) -> Identity (Set (FilePath, Text)))
 -> DebInfo -> Identity DebInfo)
-> (Set (FilePath, Text) -> Set (FilePath, Text)) -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (FilePath, Text) -> Set (FilePath, Text) -> Set (FilePath, Text)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FilePath
path, Text
text))

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

parseSourceDebDescription :: Paragraph' String -> [Paragraph' String] -> (S.SourceDebDescription, [Field])
parseSourceDebDescription :: Paragraph' FilePath
-> [Paragraph' FilePath] -> (SourceDebDescription, [Field])
parseSourceDebDescription (Paragraph [Field]
fields) [Paragraph' FilePath]
binaryParagraphs =
    (Field
 -> (SourceDebDescription, [Field])
 -> (SourceDebDescription, [Field]))
-> (SourceDebDescription, [Field])
-> [Field]
-> (SourceDebDescription, [Field])
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 = FilePath -> (FilePath -> SrcPkgName) -> [Field] -> SrcPkgName
forall a. FilePath -> (FilePath -> a) -> [Field] -> a
findMap FilePath
"Source" FilePath -> SrcPkgName
SrcPkgName [Field]
fields'
      findMaint :: NameAddr
findMaint = FilePath -> (FilePath -> NameAddr) -> [Field] -> NameAddr
forall a. FilePath -> (FilePath -> a) -> [Field] -> a
findMap FilePath
"Maintainer" (\ FilePath
m -> (FilePath -> NameAddr)
-> (NameAddr -> NameAddr) -> Either FilePath NameAddr -> NameAddr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ FilePath
e -> FilePath -> NameAddr
forall a. HasCallStack => FilePath -> a
error (FilePath -> NameAddr) -> FilePath -> NameAddr
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse maintainer field " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
e) NameAddr -> NameAddr
forall a. a -> a
id (Either FilePath NameAddr -> NameAddr)
-> (FilePath -> Either FilePath NameAddr) -> FilePath -> NameAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath NameAddr
parseMaintainer (FilePath -> NameAddr) -> FilePath -> NameAddr
forall a b. (a -> b) -> a -> b
$ FilePath
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' FilePath -> (BinaryDebDescription, [Field]))
-> [Paragraph' FilePath] -> [(BinaryDebDescription, [Field])]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph' FilePath -> (BinaryDebDescription, [Field])
parseBinaryDebDescription [Paragraph' FilePath]
binaryParagraphs
      readField :: Field -> (S.SourceDebDescription, [Field]) -> (S.SourceDebDescription, [Field])
      -- Mandatory
      readField :: Field
-> (SourceDebDescription, [Field])
-> (SourceDebDescription, [Field])
readField (Field (FilePath
"Source", FilePath
_)) (SourceDebDescription, [Field])
x = (SourceDebDescription, [Field])
x
      readField (Field (FilePath
"Maintainer", FilePath
_)) (SourceDebDescription, [Field])
x = (SourceDebDescription, [Field])
x
      -- readField (Field ("Standards-Version", _)) x = x
      -- Recommended
      readField (Field (FilePath
"Standards-Version", FilePath
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 (FilePath -> StandardsVersion
parseStandardsVersion FilePath
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Priority", FilePath
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 (FilePath -> PackagePriority
readPriority FilePath
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Section", FilePath
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 (FilePath -> Section
MainSection FilePath
value)) SourceDebDescription
desc, [Field]
unrecognized)
      -- Optional
      readField (Field (FilePath
"Homepage", FilePath
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 (FilePath -> Text
pack FilePath
value))) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Uploaders", FilePath
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 ((FilePath -> [NameAddr])
-> ([NameAddr] -> [NameAddr])
-> Either FilePath [NameAddr]
-> [NameAddr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([NameAddr] -> FilePath -> [NameAddr]
forall a b. a -> b -> a
const []) [NameAddr] -> [NameAddr]
forall a. a -> a
id (FilePath -> Either FilePath [NameAddr]
parseUploaders FilePath
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"DM-Upload-Allowed", FilePath
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 (FilePath -> Bool
yes FilePath
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Build-Depends", FilePath
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 (FilePath -> Relations
rels FilePath
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Build-Conflicts", FilePath
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 (FilePath -> Relations
rels FilePath
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Build-Depends-Indep", FilePath
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 (FilePath -> Relations
rels FilePath
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Build-Conflicts-Indep", FilePath
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 (FilePath -> Relations
rels FilePath
value) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Browser", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Arch", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Bzr", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Cvs", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Darcs", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Git", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Hg", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Mtn", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Vcs-Svn", FilePath
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 (FilePath -> Text
pack FilePath
s)) Set VersionControlSpec
vcsFields) SourceDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"X-Description", FilePath
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 (FilePath -> Text
pack FilePath
value)) SourceDebDescription
desc, [Field]
unrecognized)
      readField field :: Field
field@(Field (Char
'X' : FilePath
fld, FilePath
value)) (SourceDebDescription
desc, [Field]
unrecognized) =
          case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
"BCS") FilePath
fld of
            (FilePath
xs, Char
'-' : FilePath
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) -> FilePath -> [XFieldDest]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> XFieldDest) -> FilePath -> XFieldDest
forall a. Read a => (FilePath -> a) -> FilePath -> a
read' (\ FilePath
s -> FilePath -> XFieldDest
forall a. HasCallStack => FilePath -> a
error (FilePath -> XFieldDest) -> FilePath -> XFieldDest
forall a b. (a -> b) -> a -> b
$ FilePath
"parseSourceDebDescription: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
s) (FilePath -> XFieldDest)
-> (Char -> FilePath) -> Char -> XFieldDest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: [])) FilePath
xs)) (FilePath -> Text
pack FilePath
more) (FilePath -> Text
pack FilePath
value)) Set XField
xFields) SourceDebDescription
desc, [Field]
unrecognized)
            (FilePath, FilePath)
_ -> (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' FilePath -> (BinaryDebDescription, [Field])
parseBinaryDebDescription (Paragraph [Field]
fields) =
    (Field
 -> (BinaryDebDescription, [Field])
 -> (BinaryDebDescription, [Field]))
-> (BinaryDebDescription, [Field])
-> [Field]
-> (BinaryDebDescription, [Field])
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 = FilePath -> (FilePath -> BinPkgName) -> [Field] -> BinPkgName
forall a. FilePath -> (FilePath -> a) -> [Field] -> a
findMap FilePath
"Package" FilePath -> BinPkgName
BinPkgName [Field]
fields'
      arch :: PackageArchitectures
arch = FilePath
-> (FilePath -> PackageArchitectures)
-> [Field]
-> PackageArchitectures
forall a. FilePath -> (FilePath -> a) -> [Field] -> a
findMap FilePath
"Architecture" FilePath -> 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 (FilePath
"Package", FilePath
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 (FilePath -> BinPkgName
BinPkgName FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Architecture", FilePath
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 (FilePath -> PackageArchitectures
parsePackageArchitectures FilePath
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Multi-Arch", FilePath
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 (FilePath -> MultiArch
readMultiArch FilePath
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Section", FilePath
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 (FilePath -> Section
readSection FilePath
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Priority", FilePath
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 (FilePath -> PackagePriority
readPriority FilePath
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Essential", FilePath
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 (FilePath -> Bool
yes FilePath
x)) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Depends", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Recommends", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Suggests", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Pre-Depends", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Breaks", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Conflicts", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Provides", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Replaces", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Built-Using", FilePath
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) (FilePath -> Relations
rels FilePath
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (FilePath
"Description", FilePath
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 (FilePath -> Text
pack FilePath
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 :: FilePath -> (FilePath -> a) -> [Field] -> a
findMap FilePath
field FilePath -> a
f [Field]
fields =
    a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> a
forall a. HasCallStack => FilePath -> a
error (FilePath -> a) -> FilePath -> a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
field FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" field in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Field] -> FilePath
forall a. Show a => a -> FilePath
show [Field]
fields) ((Field -> Maybe a -> Maybe a) -> Maybe a -> [Field] -> Maybe a
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 (FilePath
fld, FilePath
val)) Maybe a
x = if FilePath
fld FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
field then a -> Maybe a
forall a. a -> Maybe a
Just (FilePath -> a
f FilePath
val) else Maybe a
x
      findMap' Field
_ Maybe a
x = Maybe a
x

stripField :: ControlFunctions a => Field' a -> Field' a
stripField :: 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 :: FilePath -> Relations
rels FilePath
s =
    (ParseError -> Relations)
-> (Relations -> Relations)
-> Either ParseError Relations
-> Relations
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ ParseError
e -> FilePath -> Relations
forall a. HasCallStack => FilePath -> a
error (FilePath
"Relations field error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s)) Relations -> Relations
forall a. a -> a
id (FilePath -> Either ParseError Relations
forall a. ParseRelations a => a -> Either ParseError Relations
parseRelations FilePath
s)

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

-- | Look in several places for a debian changelog
inputChangeLog :: MonadIO m => DebianT m ()
inputChangeLog :: DebianT m ()
inputChangeLog =
    do Maybe ChangeLog
log <- IO (Maybe ChangeLog) -> StateT DebInfo m (Maybe ChangeLog)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ChangeLog)
loadChangeLog
       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 =
    [FilePath] -> IO (Maybe ChangeLog)
doPaths [FilePath
"CHANGELOG", FilePath
"ChangeLog", FilePath
"changelog", FilePath
"debian/changelog"]
    where
      doPaths :: [FilePath] -> IO (Maybe ChangeLog)
      doPaths :: [FilePath] -> IO (Maybe ChangeLog)
doPaths (FilePath
p : [FilePath]
ps) = FilePath -> IO (Maybe ChangeLog)
doPath FilePath
p IO (Maybe ChangeLog)
-> (Maybe ChangeLog -> IO (Maybe ChangeLog))
-> IO (Maybe ChangeLog)
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 ([FilePath] -> IO (Maybe ChangeLog)
doPaths [FilePath]
ps) (\ChangeLog
log -> {-putStrLn ("Found valid changelog at " ++ p) >>-} Maybe ChangeLog -> IO (Maybe ChangeLog)
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ChangeLog
forall a. Maybe a
Nothing
      doPath :: FilePath -> IO (Maybe ChangeLog)
      doPath :: FilePath -> IO (Maybe ChangeLog)
doPath FilePath
p = do
        Either IOError Text
t <- IO Text -> IO (Either IOError Text)
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO Text
readFile FilePath
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 (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
$ ([[FilePath]] -> Maybe ChangeLog)
-> (ChangeLog -> Maybe ChangeLog)
-> Either [[FilePath]] ChangeLog
-> Maybe ChangeLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ChangeLog -> [[FilePath]] -> 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 (FilePath -> Either [[FilePath]] ChangeLog
parseChangeLog (Text -> FilePath
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ChangeLog
forall a. Maybe a
Nothing
            doExn IOError
e = FilePath -> IO (Maybe ChangeLog)
forall a. HasCallStack => FilePath -> a
error (FilePath
"inputChangelog: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
e)

inputCabalInfoFromDirectory :: MonadIO m => DebianT m () -- .install files, .init files, etc.
inputCabalInfoFromDirectory :: 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
       FilePath -> DebianT m ()
forall (m :: * -> *). MonadIO m => FilePath -> DebianT m ()
doFiles (FilePath
"./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 :: DebianT m ()
findFiles =
          IO [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
getDirectoryContents' (FilePath
"debian")) StateT DebInfo m [FilePath]
-> ([FilePath] -> StateT DebInfo m [FilePath])
-> StateT DebInfo m [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> StateT DebInfo m [FilePath])
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> StateT DebInfo m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"source/format"]) StateT DebInfo m [FilePath]
-> ([FilePath] -> StateT DebInfo m [FilePath])
-> StateT DebInfo m [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          IO [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT DebInfo m [FilePath])
-> ([FilePath] -> IO [FilePath])
-> [FilePath]
-> StateT DebInfo m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
"debian") FilePath -> FilePath -> FilePath
</>)) StateT DebInfo m [FilePath]
-> ([FilePath] -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [FilePath]
names ->
          (FilePath -> DebianT m ()) -> [FilePath] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> DebianT m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> DebianT m ()
inputCabalInfo (FilePath
"debian")) [FilePath]
names
      findChangeLog :: MonadIO m => DebianT m ()
      findChangeLog :: DebianT m ()
findChangeLog =
          (FilePath -> StateT DebInfo m Bool)
-> [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> StateT DebInfo m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT DebInfo m Bool)
-> (FilePath -> IO Bool) -> FilePath -> StateT DebInfo m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesFileExist) [FilePath
"changelog", FilePath
"ChangeLog", FilePath
"CHANGELOG"] StateT DebInfo m [FilePath]
-> ([FilePath] -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[FilePath]
names ->
          (FilePath -> DebianT m ()) -> [FilePath] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> DebianT m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> DebianT m ()
inputCabalInfo FilePath
".") [FilePath]
names
      doFiles :: MonadIO m => FilePath -> DebianT m ()
      doFiles :: FilePath -> DebianT m ()
doFiles FilePath
tmp =
          do [FilePath]
sums <- IO [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT DebInfo m [FilePath])
-> IO [FilePath] -> StateT DebInfo m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents' FilePath
tmp IO [FilePath] -> (IOError -> IO [FilePath]) -> IO [FilePath]
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\ IOError
_ -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
             [FilePath]
paths <- IO [FilePath] -> StateT DebInfo m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT DebInfo m [FilePath])
-> IO [FilePath] -> StateT DebInfo m [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ FilePath
sum -> FilePath -> IO [FilePath]
getDirectoryContents' (FilePath
tmp FilePath -> FilePath -> FilePath
</> FilePath
sum) IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
sum FilePath -> FilePath -> FilePath
</>)) [FilePath]
sums IO [[FilePath]] -> ([[FilePath]] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'~') (Char -> Bool) -> (FilePath -> Char) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Char
forall a. [a] -> a
last) ([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
             [Text]
files <- IO [Text] -> StateT DebInfo m [Text]
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
$ (FilePath -> IO Text) -> [FilePath] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> IO Text
readFile (FilePath -> IO Text)
-> (FilePath -> FilePath) -> FilePath -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
tmp FilePath -> FilePath -> FilePath
</>)) [FilePath]
paths
             ((FilePath, Text) -> DebianT m ())
-> [(FilePath, Text)] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (FilePath, Text)
x -> (Set (FilePath, Text) -> Identity (Set (FilePath, Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Set (FilePath, Text))
intermediateFiles ((Set (FilePath, Text) -> Identity (Set (FilePath, Text)))
 -> DebInfo -> Identity DebInfo)
-> (Set (FilePath, Text) -> Set (FilePath, Text)) -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (FilePath, Text) -> Set (FilePath, Text) -> Set (FilePath, Text)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FilePath, Text)
x) ([FilePath] -> [Text] -> [(FilePath, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"debian/cabalInstall" FilePath -> FilePath -> FilePath
</>) [FilePath]
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 :: FilePath -> FilePath -> DebianT m ()
inputCabalInfo FilePath
_ FilePath
path | FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
path [FilePath
"control"] = () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
inputCabalInfo FilePath
debian name :: FilePath
name@FilePath
"source/format" = IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> DebianT m ())
-> (SourceFormat -> DebianT m ())
-> Either Text SourceFormat
-> DebianT 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) -> DebianT 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 -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)) (Text -> Either Text SourceFormat
readSourceFormat Text
text)
inputCabalInfo FilePath
debian name :: FilePath
name@FilePath
"watch" = IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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 -> DebianT 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 FilePath
debian name :: FilePath
name@FilePath
"rules" = IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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 -> DebianT 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
<> FilePath -> Text
pack FilePath
"\n")
inputCabalInfo FilePath
debian name :: FilePath
name@FilePath
"compat" = IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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 -> DebianT 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 ((FilePath -> Int) -> FilePath -> Int
forall a. Read a => (FilePath -> a) -> FilePath -> a
read' (\ FilePath
s -> FilePath -> Int
forall a. HasCallStack => FilePath -> a
error (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ FilePath
"compat: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
s) (Text -> FilePath
unpack Text
text))
inputCabalInfo FilePath
debian name :: FilePath
name@FilePath
"copyright" = IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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 -> DebianT 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 FilePath
debian name :: FilePath
name@FilePath
"changelog" = do
  Maybe ChangeLog
log <- IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text
-> (Text -> StateT DebInfo m (Maybe ChangeLog))
-> StateT DebInfo m (Maybe ChangeLog)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ChangeLog -> StateT DebInfo m (Maybe ChangeLog)
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
. ([[FilePath]] -> Maybe ChangeLog)
-> (ChangeLog -> Maybe ChangeLog)
-> Either [[FilePath]] ChangeLog
-> Maybe ChangeLog
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ChangeLog -> [[FilePath]] -> 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 [[FilePath]] ChangeLog -> Maybe ChangeLog)
-> (Text -> Either [[FilePath]] ChangeLog)
-> Text
-> Maybe ChangeLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either [[FilePath]] ChangeLog
parseChangeLog (FilePath -> Either [[FilePath]] ChangeLog)
-> (Text -> FilePath) -> Text -> Either [[FilePath]] ChangeLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack
  (Maybe ChangeLog -> Identity (Maybe ChangeLog))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Maybe ChangeLog)
changelog ((Maybe ChangeLog -> Identity (Maybe ChangeLog))
 -> DebInfo -> Identity DebInfo)
-> Maybe ChangeLog -> DebianT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ChangeLog
log
inputCabalInfo FilePath
debian FilePath
name =
    case (FilePath -> BinPkgName
BinPkgName (FilePath -> FilePath
dropExtension FilePath
name), FilePath -> FilePath
takeExtension FilePath
name) of
      (BinPkgName
p, FilePath
".install") ->   IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> DebianT m ()) -> [Text] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> DebianT m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readInstall BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, FilePath
".dirs") ->      IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> DebianT m ()) -> [Text] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> DebianT m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readDir BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, FilePath
".init") ->      IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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) -> DebianT 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, FilePath
".logrotate") -> IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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))
-> DebianT 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, FilePath
".links") ->     IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> (Text -> DebianT m ()) -> [Text] -> DebianT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinPkgName -> Text -> DebianT m ()
forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readLink BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, FilePath
".postinst") ->  IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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) -> DebianT 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, FilePath
".postrm") ->    IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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) -> DebianT 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, FilePath
".preinst") ->   IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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) -> DebianT 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, FilePath
".prerm") ->     IO Text -> StateT DebInfo m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
readFile (FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)) StateT DebInfo m Text -> (Text -> DebianT m ()) -> DebianT m ()
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) -> DebianT 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
_, FilePath
".log") ->       () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, FilePath
".debhelper") -> () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, FilePath
".hs") ->        () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Code that uses this library
      (BinPkgName
_, FilePath
".setup") ->     () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Compiled Setup.hs file
      (BinPkgName
_, FilePath
".substvars") -> () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Unsupported
      (BinPkgName
_, FilePath
"") ->           () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- File with no extension
      (BinPkgName
_, FilePath
x) | FilePath -> Char
forall a. [a] -> a
last FilePath
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' -> () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- backup file
      (BinPkgName, FilePath)
_ -> IO () -> DebianT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Ignored debianization file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
debian FilePath -> FilePath -> FilePath
</> FilePath
name)

-- | Read a line from a debian .links file
readLink :: Monad m => BinPkgName -> Text -> DebianT m ()
readLink :: BinPkgName -> Text -> DebianT m ()
readLink BinPkgName
p Text
line =
    case Text -> [Text]
words Text
line of
      [Text
a, Text
b] -> BinPkgName -> FilePath -> FilePath -> DebianT m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
link BinPkgName
p (Text -> FilePath
unpack Text
a) (Text -> FilePath
unpack Text
b)
      [] -> () -> DebianT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Text]
_ -> FilePath -> DebianT m () -> DebianT m ()
forall a. FilePath -> a -> a
trace (FilePath
"Unexpected value passed to readLink: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
line) (() -> DebianT m ()
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 :: 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 -> FilePath -> DebianT m ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> DebianT m ()) -> FilePath -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"readInstall: syntax error in .install file for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BinPkgName -> FilePath
forall a. Show a => a -> FilePath
show BinPkgName
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
line
      (Text
a, Text
b) -> BinPkgName -> FilePath -> FilePath -> DebianT m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> FilePath -> FilePath -> StateT DebInfo m ()
install BinPkgName
p (Text -> FilePath
unpack (Text -> Text
strip Text
a)) (Text -> FilePath
unpack (Text -> Text
strip Text
b))

-- | Read a line from a debian .dirs file
readDir :: Monad m => BinPkgName -> Text -> DebianT m ()
readDir :: BinPkgName -> Text -> DebianT m ()
readDir BinPkgName
p Text
line = BinPkgName -> FilePath -> DebianT m ()
forall (m :: * -> *).
Monad m =>
BinPkgName -> FilePath -> StateT DebInfo m ()
installDir BinPkgName
p (Text -> FilePath
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 :: CabalT m FilePath
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
  FilePath -> CabalT m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> CabalT m FilePath) -> FilePath -> CabalT m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"usr/share" FilePath -> FilePath -> FilePath
</> (PackageName -> FilePath
unPackageName (PackageName -> FilePath) -> PackageName -> FilePath
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 :: CabalT m FilePath
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
  FilePath -> CabalT m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> CabalT m FilePath) -> FilePath -> CabalT m FilePath
forall a b. (a -> b) -> a -> b
$ case PackageDescription -> FilePath
Cabal.dataDir PackageDescription
d of
             FilePath
"" -> FilePath
"."
             FilePath
x -> FilePath
x