-- | 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' DebInfo Flags
T.flags
       forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ Flags -> DebInfo
T.makeDebInfo Flags
fs
       (SourceDebDescription
ctl, [Field]
_) <- forall (m :: * -> *).
MonadIO m =>
DebianT m (SourceDebDescription, [Field])
inputSourceDebDescription
       forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory
       Lens' DebInfo SourceDebDescription
control 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 forall (m :: * -> *). MonadIO m => DebianT m ()
inputCabalInfoFromDirectory
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe Text)
readFileMaybe String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\ Text
text -> Lens' DebInfo (Set (String, Text))
intermediateFiles forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
"debian/control" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Control' a -> [Paragraph' a]
unControl)
       case [Paragraph' String]
paras of
         [] -> forall a. HasCallStack => String -> a
error String
"Missing source paragraph"
         [Paragraph' String
_] -> forall a. HasCallStack => String -> a
error String
"Missing binary paragraph"
         (Paragraph' String
hd : [Paragraph' String]
tl) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
    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' = forall a b. (a -> b) -> [a] -> [b]
map forall a. ControlFunctions a => Field' a -> Field' a
stripField [Field]
fields
      src :: SourceDebDescription
src = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription [BinaryDebDescription]
S.binaryPackages [BinaryDebDescription]
bins (SrcPkgName -> NameAddr -> SourceDebDescription
S.newSourceDebDescription' SrcPkgName
findSource NameAddr
findMaint)
      findSource :: SrcPkgName
findSource = forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Source" String -> SrcPkgName
SrcPkgName [Field]
fields'
      findMaint :: NameAddr
findMaint = forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Maintainer" (\ String
m -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ String
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to parse maintainer field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
m forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
e) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String NameAddr
parseMaintainer forall a b. (a -> b) -> a -> b
$ String
m) [Field]
fields'
      -- findStandards = findMap "Standards-Version" parseStandardsVersion fields'

      ([BinaryDebDescription]
bins, [[Field]]
_extra) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription (Maybe StandardsVersion)
S.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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription (Maybe PackagePriority)
S.priority (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription (Maybe Section)
S.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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription (Maybe Text)
S.homepage (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription [NameAddr]
S.uploaders (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields (\ Set VersionControlSpec
vcsFields -> 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' SourceDebDescription (Maybe Text)
S.xDescription (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 forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"BCS") String
fld of
            (String
xs, Char
'-' : String
more) -> (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' SourceDebDescription (Set XField)
S.xFields (\ Set XField
xFields -> forall a. Ord a => a -> Set a -> Set a
Set.insert (Set XFieldDest -> Text -> Text -> XField
S.XField (forall a. Ord a => [a] -> Set a
fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Read a => (String -> a) -> String -> a
read' (\ String
s -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"parseSourceDebDescription: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 forall a. a -> [a] -> [a]
: [Field]
unrecognized)
      readField Field
field (SourceDebDescription
desc, [Field]
unrecognized) = (SourceDebDescription
desc, Field
field forall a. a -> [a] -> [a]
: [Field]
unrecognized)

parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])
parseBinaryDebDescription :: Paragraph' String -> (BinaryDebDescription, [Field])
parseBinaryDebDescription (Paragraph [Field]
fields) =
    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' = forall a b. (a -> b) -> [a] -> [b]
map forall a. ControlFunctions a => Field' a -> Field' a
stripField [Field]
fields
      bin :: BinaryDebDescription
bin = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe PackageArchitectures)
B.architecture (forall a. a -> Maybe a
Just PackageArchitectures
arch) (BinPkgName -> BinaryDebDescription
newBinaryDebDescription BinPkgName
b)
      b :: BinPkgName
      b :: BinPkgName
b = forall a. String -> (String -> a) -> [Field] -> a
findMap String
"Package" String -> BinPkgName
BinPkgName [Field]
fields'
      arch :: PackageArchitectures
arch = 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription BinPkgName
B.package (String -> BinPkgName
BinPkgName String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Architecture", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe PackageArchitectures)
B.architecture (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe MultiArch)
B.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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe Section)
B.binarySection (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe PackagePriority)
B.binaryPriority (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe Bool)
B.essential (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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.depends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Recommends", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.recommends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Suggests", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.preDepends) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Breaks", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.breaks) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Conflicts", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.conflicts) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Provides", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.provides) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Replaces", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = (forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' BinaryDebDescription PackageRelations
B.relations forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageRelations Relations
B.builtUsing) (String -> Relations
rels String
x) BinaryDebDescription
desc, [Field]
unrecognized)
      readField (Field (String
"Description", String
x)) (BinaryDebDescription
desc, [Field]
unrecognized) = (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' BinaryDebDescription (Maybe Text)
B.description (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 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 =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Missing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
field forall a. [a] -> [a] -> [a]
++ String
" field in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Field]
fields) (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field -> Maybe a -> Maybe a
findMap' 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 forall a. Eq a => a -> a -> Bool
== String
field then 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)) = forall a. (a, a) -> Field' a
Field (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 =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ ParseError
e -> forall a. HasCallStack => String -> a
error (String
"Relations field error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
e forall a. [a] -> [a] -> [a]
++ String
"\n  " forall a. [a] -> [a] -> [a]
++ String
s)) forall a. a -> a
id (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 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Expecting yes or no: " 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ChangeLog)
loadChangeLog
       Lens' DebInfo (Maybe ChangeLog)
changelog 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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) >>-} forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ChangeLog
log))
      doPaths [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      doPath :: FilePath -> IO (Maybe ChangeLog)
      doPath :: String -> IO (Maybe ChangeLog)
doPath String
p = do
        Either IOError Text
t <- forall a. IO a -> IO (Either IOError a)
tryIOError (String -> IO Text
readFile String
p)
        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
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            doExn IOError
e = forall a. HasCallStack => String -> a
error (String
"inputChangelog: " forall a. [a] -> [a] -> [a]
++ 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 forall (m :: * -> *). MonadIO m => DebianT m ()
findChangeLog -- Look for changelog in unconventional locations
       forall (m :: * -> *). MonadIO m => DebianT m ()
findFiles     -- If debian/changelog is found it will replace what we found above
       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 =
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
getDirectoryContents' (String
"debian")) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [String
"source/format"]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"debian") String -> String -> String
</>)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [String]
names ->
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 =
          forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist) [String
"changelog", String
"ChangeLog", String
"CHANGELOG"] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String]
names ->
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents' String
tmp forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\ IOError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
             [String]
paths <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ String
sum -> String -> IO [String]
getDirectoryContents' (String
tmp String -> String -> String
</> String
sum) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
sum String -> String -> String
</>)) [String]
sums forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Char
'~') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
             [Text]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO Text
readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
tmp String -> String -> String
</>)) [String]
paths
             forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (String, Text)
x -> Lens' DebInfo (Set (String, Text))
intermediateFiles forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert (String, Text)
x) (forall a b. [a] -> [b] -> [(a, b)]
zip (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 | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
path [String
"control"] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
inputCabalInfo String
debian name :: String
name@String
"source/format" = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ Text
x -> Lens' DebInfo (Set Text)
warning forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert Text
x) ((Lens' DebInfo SourceFormat
sourceFormat 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" = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Maybe Text)
watch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Text
text
inputCabalInfo String
debian name :: String
name@String
"rules" = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Maybe Text)
rulesHead forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
strip Text
text forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
"\n")
inputCabalInfo String
debian name :: String
name@String
"compat" = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Maybe Int)
compat forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (forall a. Read a => (String -> a) -> String -> a
read' (\ String
s -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"compat: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s) (Text -> String
unpack Text
text))
inputCabalInfo String
debian name :: String
name@String
"copyright" = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Maybe CopyrightDescription)
copyright forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either [[String]] ChangeLog
parseChangeLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  Lens' DebInfo (Maybe ChangeLog)
changelog 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") ->   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readInstall BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".dirs") ->      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readDir BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".init") ->      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName Text)
installInit forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".logrotate") -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName (Set Text))
logrotateStanza forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Monoid a => a -> a -> a
mappend BinPkgName
p (forall a. a -> Set a
singleton Text
text)
      (BinPkgName
p, String
".links") ->     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). Monad m => BinPkgName -> Text -> DebianT m ()
readLink BinPkgName
p) (Text -> [Text]
lines Text
text)
      (BinPkgName
p, String
".postinst") ->  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName Text)
postInst forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".postrm") ->    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName Text)
postRm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".preinst") ->   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName Text)
preInst forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
p, String
".prerm") ->     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFile (String
debian String -> String -> String
</> String
name)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Text
text -> Lens' DebInfo (Map BinPkgName Text)
preRm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Text
text
      (BinPkgName
_, String
".log") ->       forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, String
".debhelper") -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- Generated by debhelper
      (BinPkgName
_, String
".hs") ->        forall (m :: * -> *) a. Monad m => a -> m a
return () -- Code that uses this library
      (BinPkgName
_, String
".setup") ->     forall (m :: * -> *) a. Monad m => a -> m a
return () -- Compiled Setup.hs file
      (BinPkgName
_, String
".substvars") -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- Unsupported
      (BinPkgName
_, String
"") ->           forall (m :: * -> *) a. Monad m => a -> m a
return () -- File with no extension
      (BinPkgName
_, String
x) | forall a. [a] -> a
last String
x forall a. Eq a => a -> a -> Bool
== Char
'~' -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- backup file
      (BinPkgName, String)
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Ignored debianization file: " 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] -> forall (m :: * -> *).
Monad m =>
BinPkgName -> String -> String -> StateT DebInfo m ()
link BinPkgName
p (Text -> String
unpack Text
a) (Text -> String
unpack Text
b)
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [Text]
_ -> forall a. String -> a -> a
trace (String
"Unexpected value passed to readLink: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
line) (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 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"readInstall: syntax error in .install file for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BinPkgName
p forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
line
      (Text
a, Text
b) -> 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 = 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo PackageDescription
packageDescription
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"usr/share" String -> String -> String
</> (PackageName -> String
unPackageName forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> PackageName
pkgName 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' CabalInfo PackageDescription
packageDescription
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case PackageDescription -> String
Cabal.dataDir PackageDescription
d of
             String
"" -> String
"."
             String
x -> String
x