Fix copyright file generation - closes #30

Tests.hs

@@ -14,6 +14,7 @@ import Data.Lens.Lazy (getL, setL)
 import Data.List (sortBy)
 import Data.Map as Map (differenceWithKey, intersectionWithKey)
 import qualified Data.Map as Map (elems, Map, toList)
+import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>), mconcat, mempty)
 import Data.Set as Set (fromList, union, insert)
 import Data.Text as Text (intercalate, split, Text, unlines, unpack)
@@ -283,7 +284,7 @@ test3 label =
                                                     "",
                                                     ""])
                 (D.compat . debInfo) ~= Just 7
-                (D.copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ c { _summaryComment = Just "This package was debianized by John Goerzen <jgoerzen@complete.org> on\nWed,  6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n" }))
+                (D.copyright . debInfo) %= (Just . id . fromMaybe (readCopyrightDescription "This package was debianized by John Goerzen <jgoerzen@complete.org> on\nWed,  6 Oct 2004 09:46:14 -0500.\n\nCopyright information removed from this test data.\n"))
                 (S.source . D.control . debInfo) ~= Just (SrcPkgName {unSrcPkgName = "haskell-devscripts"})
                 (S.maintainer . D.control . debInfo) ~= Just (NameAddr {nameAddr_name = Just "Debian Haskell Group", nameAddr_addr = "pkg-haskell-maintainers@lists.alioth.debian.org"})
                 (S.uploaders . D.control . debInfo) ~= [NameAddr {nameAddr_name = Just "Marco Silva", nameAddr_addr = "marcot@debian.org"},NameAddr {nameAddr_name = Just "Joachim Breitner", nameAddr_addr = "nomeata@debian.org"}]

debian/Debianize.hs

@@ -10,8 +10,10 @@
 import Control.Category ((.))
 import Control.Exception (throw)
 import Control.Monad.State (get)
+import Data.Default (def)
 import Data.Lens.Lazy (getL, access)
 import Data.List (intercalate)
+import Data.Maybe (fromMaybe)
 import Data.Monoid (mempty)
 import Data.Set as Set (singleton, insert)
 import Data.Text as Text (Text, pack)
@@ -67,7 +69,7 @@ main =
              (standardsVersion . control . debInfo) ~= Just (StandardsVersion 3 9 3 Nothing)
              (compat . debInfo) ~= Just 9
              (utilsPackageNameBase . debInfo) ~= Just "cabal-debian"
-             (copyright . debInfo) %= (\ f -> (\ pkgDesc -> f pkgDesc >>= \ c -> return $ copyrightFn c))
+             (copyright . debInfo) %= (Just . copyrightFn . fromMaybe def)
              (conflicts . relations . binaryDebDescription (BinPkgName "cabal-debian") . debInfo) %= (++ (rels "haskell-debian-utils (<< 3.59)"))
              (depends . relations . binaryDebDescription (BinPkgName "cabal-debian") . debInfo) %= (++ (rels "apt-file, debian-policy, debhelper, haskell-devscripts (>= 0.8.19)"))
              (depends . relations . binaryDebDescription (BinPkgName "libghc-cabal-debian-dev") . debInfo) %= (++ (rels "debian-policy"))
@@ -83,8 +85,7 @@ rels = either (throw . userError . show) id . parseRelations
 -- | Demonstrates the structure of the new copyright type.
 copyrightFn :: CopyrightDescription -> CopyrightDescription
 copyrightFn =
-    const $ newCopyrightDescription
-                    { _filesAndLicenses =       [FilesDescription { _filesPattern = "*"
+    const $ def     { _filesAndLicenses =       [FilesDescription { _filesPattern = "*"
                                                                   , _filesCopyright = pack (unlines [ "Copyright (c) 2007, David Fox"
                                                                                                     , "Copyright (c) 2007, Jeremy Shaw" ])
                                                                   , _filesLicense = OtherLicense "Proprietary"

src/Debian/Debianize/CabalInfo.hs

@@ -17,15 +17,20 @@ module Debian.Debianize.CabalInfo
     , newCabalInfo
     ) where
 
+import Control.Category ((.))
+import Control.Monad.Trans (liftIO)
+import Data.Default (def)
 import Data.Generics (Data, Typeable)
+import Data.Lens.Common (setL)
 import Data.Lens.Template (nameMakeLens)
 import Data.List (init)
 import Data.Map as Map (Map)
 import Data.Monoid (Monoid(..))
 import Debian.Debianize.BasicInfo (Flags)
-import Debian.Debianize.DebInfo (DebInfo, makeDebInfo)
-import Debian.Debianize.InputCabal (inputCabalization)
+import Debian.Debianize.DebInfo (copyright, DebInfo, makeDebInfo)
 import Debian.Debianize.BinaryDebDescription (Canonical(canonical))
+import Debian.Debianize.CopyrightDescription (defaultCopyrightDescription)
+import Debian.Debianize.InputCabal (inputCabalization)
 import Debian.Debianize.VersionSplits (VersionSplits)
 import Debian.Orphans ()
 import Debian.Relation (BinPkgName)
@@ -65,6 +70,16 @@ data CabalInfo
       -- ^ Supply some info about a cabal package.
       } deriving (Show, Data, Typeable)
 
+data PackageInfo = PackageInfo { cabalName :: PackageName
+                               , devDeb :: Maybe (BinPkgName, DebianVersion)
+                               , profDeb :: Maybe (BinPkgName, DebianVersion)
+                               , docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable)
+
+$(let f s = case s of
+              (_ : _) | last s == '_' -> Just (init s)
+              _ -> Nothing in
+  nameMakeLens ''CabalInfo f)
+
 instance Canonical CabalInfo where
     canonical x = x {debInfo_ = canonical (debInfo_ x)}
 
@@ -73,7 +88,8 @@ instance Canonical CabalInfo where
 newCabalInfo :: Flags -> IO CabalInfo
 newCabalInfo flags' = do
   pkgDesc <- inputCabalization flags'
-  return $ makeCabalInfo flags' pkgDesc
+  copyrt <- liftIO $ defaultCopyrightDescription def pkgDesc
+  return $ setL (copyright . debInfo) (Just copyrt) (makeCabalInfo flags' pkgDesc)
 
 makeCabalInfo :: Flags -> PackageDescription -> CabalInfo
 makeCabalInfo fs pkgDesc =
@@ -84,13 +100,3 @@ makeCabalInfo fs pkgDesc =
       , debianNameMap_ = mempty
       , debInfo_ = makeDebInfo fs
       }
-
-data PackageInfo = PackageInfo { cabalName :: PackageName
-                               , devDeb :: Maybe (BinPkgName, DebianVersion)
-                               , profDeb :: Maybe (BinPkgName, DebianVersion)
-                               , docDeb :: Maybe (BinPkgName, DebianVersion) } deriving (Eq, Ord, Show, Data, Typeable)
-
-$(let f s = case s of
-              (_ : _) | last s == '_' -> Just (init s)
-              _ -> Nothing in
-  nameMakeLens ''CabalInfo f)

src/Debian/Debianize/DebInfo.hs

@@ -86,7 +86,7 @@ module Debian.Debianize.DebInfo
 
 import Control.Category ((.))
 import Control.Monad.State (StateT)
-import Data.Default (def)
+--import Data.Default (def)
 import Data.Generics (Data, Typeable)
 import Data.Lens.Common (Lens, iso, getL)
 import Data.Lens.Lazy ((%=))
@@ -100,14 +100,13 @@ import Debian.Changes (ChangeLog)
 import Debian.Debianize.BasicInfo (Flags)
 import Debian.Debianize.Prelude (listElemLens, maybeLens)
 import Debian.Debianize.BinaryDebDescription (BinaryDebDescription, Canonical(canonical), newBinaryDebDescription, package)
-import Debian.Debianize.CopyrightDescription (CopyrightDescription, defaultCopyrightDescription)
+import Debian.Debianize.CopyrightDescription (CopyrightDescription)
 import qualified Debian.Debianize.SourceDebDescription as S (newSourceDebDescription, SourceDebDescription, binaryPackages)
 import Debian.Debianize.VersionSplits (DebBase)
 import Debian.Orphans ()
 import Debian.Policy (PackageArchitectures, PackagePriority, Section, SourceFormat)
 import Debian.Relation (BinPkgName, Relations, SrcPkgName)
 import Debian.Version (DebianVersion)
-import Distribution.PackageDescription as Cabal (PackageDescription)
 import Prelude hiding ((.), init, init, log, log)
 import Text.ParserCombinators.Parsec.Rfc2822 (NameAddr)
 
@@ -130,16 +129,14 @@ data DebInfo
       -- ^ The rules file include directives
       , rulesFragments_ :: Set Text
       -- ^ Additional fragments of the rules file
-      , copyright_ :: PackageDescription -> IO CopyrightDescription
-      -- ^ Copyright and license information.  This function takes a list of FilePath like
-      -- the licenseFiles field of the PackageDescription and returns a CopyrightDescription.
+      , copyright_ :: Maybe CopyrightDescription
+      -- ^ Override the copyright value computed from the cabal package description.
       , control_ :: S.SourceDebDescription
       -- ^ The parsed contents of the control file
       , intermediateFiles_ :: Set (FilePath, Text)
       -- ^ Put this text into a file with the given name in the debianization.
       , compat_ :: Maybe Int
       -- ^ The debhelper compatibility level, from debian/compat.
-      -- , copyright_ :: Maybe (Either CopyrightDescription Text)
       , changelog_ :: Maybe ChangeLog
       -- ^ The changelog, first entry contains the source package name and version
       , installInit_ :: Map BinPkgName Text
@@ -318,7 +315,7 @@ makeDebInfo fs =
     , rulesSettings_ = mempty
     , rulesIncludes_ = mempty
     , rulesFragments_ = mempty
-    , copyright_ = defaultCopyrightDescription def
+    , copyright_ = Nothing
     , control_ = S.newSourceDebDescription
     , intermediateFiles_ = mempty
     , compat_ = Nothing

src/Debian/Debianize/Files.hs

@@ -20,7 +20,7 @@ import Data.Set as Set (fold, member, toList)
 import Data.Text as Text (dropWhile, dropWhileEnd, intercalate, lines, null, pack, strip, Text, unlines, unpack)
 import Debian.Control (Control'(Control, unControl), Field'(Field), Paragraph'(Paragraph))
 import Debian.Control.Common ()
-import qualified Debian.Debianize.DebInfo as T (Atom(Install, InstallDir, Link), atomSet, changelog, compat, control, copyright, installInit, intermediateFiles, logrotateStanza, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, watch)
+import qualified Debian.Debianize.DebInfo as D (Atom(Install, InstallDir, Link), atomSet, changelog, compat, control, copyright, installInit, intermediateFiles, logrotateStanza, postInst, postRm, preInst, preRm, rulesFragments, rulesHead, rulesIncludes, rulesSettings, sourceFormat, watch)
 import Debian.Debianize.Monad (DebianT)
 import Debian.Debianize.Prelude (showDeps')
 import qualified Debian.Debianize.BinaryDebDescription as B (architecture, BinaryDebDescription, binaryPriority, binarySection, breaks, builtUsing, conflicts, depends, description, essential, package, PackageRelations, preDepends, provides, recommends, relations, replaces, suggests)
@@ -69,102 +69,102 @@ debianizationFileMap =
 
 sourceFormatFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 sourceFormatFiles =
-    maybe [] (\ x -> [("debian/source/format", pack (ppDisplay x))]) <$> (lift $ access T.sourceFormat)
+    maybe [] (\ x -> [("debian/source/format", pack (ppDisplay x))]) <$> (lift $ access D.sourceFormat)
 
 watchFile :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
-watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ access T.watch)
+watchFile = maybe [] (\ x -> [("debian/watch", x)]) <$> (lift $ access D.watch)
 
 intermediates :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
-intermediates = Set.toList <$> (lift $ access T.intermediateFiles)
+intermediates = Set.toList <$> (lift $ access D.intermediateFiles)
 
 installs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 installs =
-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access (T.atomSet))
+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access (D.atomSet))
     where
-      doAtom (T.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp
+      doAtom (D.Install b from dest) mp = Map.insertWith (++) (pathf b) [pack (from <> " " <> dest)] mp
       doAtom _ mp = mp
       pathf name = "debian" </> show (ppPrint name) ++ ".install"
 
 dirs :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 dirs =
-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)
+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access D.atomSet)
     where
-      doAtom (T.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp
+      doAtom (D.InstallDir b dir) mp = Map.insertWith (++) (pathf b) [pack dir] mp
       doAtom _ mp = mp
       pathf name = "debian" </> show (ppPrint name) ++ ".dirs"
 
 init :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 init =
-    (Map.toList . mapKeys pathf) <$> (lift $ access T.installInit)
+    (Map.toList . mapKeys pathf) <$> (lift $ access D.installInit)
     where
       pathf name = "debian" </> show (ppPrint name) ++ ".init"
 
 -- FIXME - use a map and insertWith, check for multiple entries
 logrotate :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 logrotate =
-    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ access T.logrotateStanza)
+    (Map.toList . Map.map (\ stanzas -> Text.unlines (Set.toList stanzas)) . mapKeys pathf) <$> (lift $ access D.logrotateStanza)
     where
       pathf name = "debian" </> show (ppPrint name) ++ ".logrotate"
 
 -- | Assemble all the links by package and output one file each
 links :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 links =
-    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access T.atomSet)
+    (Map.toList . Map.map unlines . Set.fold doAtom mempty) <$> (lift $ access D.atomSet)
     where
-      doAtom (T.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp
+      doAtom (D.Link b loc t) mp = Map.insertWith (++) (pathf b) [pack loc <> " " <> pack t] mp
       doAtom _ mp = mp
       pathf name = "debian" </> show (ppPrint name) ++ ".links"
 
 postinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 postinstFiles =
-     (Map.toList . mapKeys pathf) <$> (lift $ access T.postInst)
+     (Map.toList . mapKeys pathf) <$> (lift $ access D.postInst)
     where
       pathf (BinPkgName name) = "debian" </> name <> ".postinst"
 
 postrmFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 postrmFiles =
-    (Map.toList . mapKeys pathf) <$> (lift $ access T.postRm)
+    (Map.toList . mapKeys pathf) <$> (lift $ access D.postRm)
     where
       pathf name = "debian" </> show (ppPrint name) ++ ".postrm"
 
 preinstFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 preinstFiles =
-    (Map.toList . mapKeys pathf) <$> (lift $ access T.preInst)
+    (Map.toList . mapKeys pathf) <$> (lift $ access D.preInst)
     where
       pathf name = "debian" </> show (ppPrint name) ++ ".preinst"
 
 prermFiles :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 prermFiles =
-    (Map.toList . mapKeys pathf) <$> (lift $ access T.preRm)
+    (Map.toList . mapKeys pathf) <$> (lift $ access D.preRm)
     where
       pathf name = "debian" </> show (ppPrint name) ++ ".prerm"
 
 rules :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 rules =
-    do Just rh <- lift (access (T.rulesHead))
-       rassignments <- lift (access (T.rulesSettings)) >>= return . intercalate "\n"
-       rincludes <- lift (access (T.rulesIncludes)) >>= return . intercalate "\n"
-       rl <- (reverse . Set.toList) <$> lift (access (T.rulesFragments))
+    do Just rh <- lift (access (D.rulesHead))
+       rassignments <- lift (access (D.rulesSettings)) >>= return . intercalate "\n"
+       rincludes <- lift (access (D.rulesIncludes)) >>= return . intercalate "\n"
+       rl <- (reverse . Set.toList) <$> lift (access (D.rulesFragments))
        return [("debian/rules", intercalate "\n\n" (filter (not . Text.null) (List.map strip (rh : rassignments : rincludes : rl))) <> "\n")]
 
 changelog :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 changelog =
-    do log <- lift $ access T.changelog
+    do log <- lift $ access D.changelog
        return [("debian/changelog", pack (show (ppPrint (fromMaybe (error "No changelog in debianization") log))))]
 
 control :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 control =
-    do d <- lift $ access T.control
+    do d <- lift $ access D.control
        return [("debian/control", ppDisplay' (controlFile d))]
 
 compat :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 compat =
-    do t <- lift $ access T.compat
+    do t <- lift $ access D.compat
        return [("debian/compat", pack (show (fromMaybe (error "Missing DebCompat atom - is debhelper installed?") $ t) <> "\n"))]
 
 copyright :: (Monad m, Functor m) => FilesT m [(FilePath, Text)]
 copyright =
-    do copyrt <- lift $ access (T.copyright)
+    do copyrt <- lift $ access (D.copyright)
        return [("debian/copyright", ppDisplay' copyrt)]
 
 instance Pretty (PP (PackageDescription -> IO CopyrightDescription)) where

src/Debian/Debianize/InputDebian.hs

@@ -203,7 +203,7 @@ inputCabalInfo debian name@"source/format" = liftIO (readFile (debian </> name))
 inputCabalInfo debian name@"watch" = liftIO (readFile (debian </> name)) >>= \ text -> watch ~= Just text
 inputCabalInfo debian name@"rules" = liftIO (readFile (debian </> name)) >>= \ text -> rulesHead ~= (Just $ strip text <> "\n")
 inputCabalInfo debian name@"compat" = liftIO (readFile (debian </> name)) >>= \ text -> compat ~= Just (read' (\ s -> error $ "compat: " ++ show s) (unpack text))
-inputCabalInfo debian name@"copyright" = liftIO (readFile (debian </> name)) >>= \ text -> copyright ~= (\ _ -> return (readCopyrightDescription text))
+inputCabalInfo debian name@"copyright" = liftIO (readFile (debian </> name)) >>= \ text -> copyright ~= Just (readCopyrightDescription text)
 inputCabalInfo debian name@"changelog" =
     liftIO (readFile (debian </> name)) >>= return . parseChangeLog . unpack >>= \ log -> changelog ~= Just log
 inputCabalInfo debian name =