{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Language.ATS.Package.Debian ( debRules
, Debian (..)
) where
import qualified Codec.Compression.GZip as Gzip
import qualified Data.ByteString.Lazy as BSL
import Data.Dependency (Version (..))
import Data.List (intercalate)
import Development.Shake hiding ((*>))
import Development.Shake.FilePath
import Dhall hiding (Text)
import Quaalude
import System.PosixCompat.Files (setFileMode)
data Debian = Debian { Debian -> Text
package :: Text
, Debian -> Version
version :: Version
, Debian -> Text
maintainer :: Text
, Debian -> Text
description :: Text
, Debian -> Text
target :: Text
, Debian -> Maybe Text
manpage :: Maybe Text
, Debian -> [Text]
binaries :: [Text]
, Debian -> [Text]
libraries :: [Text]
, :: [Text]
, Debian -> Maybe Text
license :: Maybe Text
, Debian -> Maybe Text
changelog :: Maybe Text
}
deriving ((forall x. Debian -> Rep Debian x)
-> (forall x. Rep Debian x -> Debian) -> Generic Debian
forall x. Rep Debian x -> Debian
forall x. Debian -> Rep Debian x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Debian x -> Debian
$cfrom :: forall x. Debian -> Rep Debian x
Generic, Get Debian
[Debian] -> Put
Debian -> Put
(Debian -> Put) -> Get Debian -> ([Debian] -> Put) -> Binary Debian
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Debian] -> Put
$cputList :: [Debian] -> Put
get :: Get Debian
$cget :: Get Debian
put :: Debian -> Put
$cput :: Debian -> Put
Binary, InputNormalizer -> Decoder Debian
(InputNormalizer -> Decoder Debian) -> FromDhall Debian
forall a. (InputNormalizer -> Decoder a) -> FromDhall a
autoWith :: InputNormalizer -> Decoder Debian
$cautoWith :: InputNormalizer -> Decoder Debian
FromDhall)
deriving newtype instance FromDhall Version
control :: Debian -> String
control :: Debian -> String
control Debian{[Text]
Maybe Text
Text
Version
changelog :: Maybe Text
license :: Maybe Text
headers :: [Text]
libraries :: [Text]
binaries :: [Text]
manpage :: Maybe Text
target :: Text
description :: Text
maintainer :: Text
version :: Version
package :: Text
changelog :: Debian -> Maybe Text
license :: Debian -> Maybe Text
headers :: Debian -> [Text]
libraries :: Debian -> [Text]
binaries :: Debian -> [Text]
manpage :: Debian -> Maybe Text
target :: Debian -> Text
description :: Debian -> Text
maintainer :: Debian -> Text
version :: Debian -> Version
package :: Debian -> Text
..} = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
[ String
"Package: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
package
, String
"Version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
version
, String
"Architecture: all"
, String
"Maintainer: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
maintainer
, String
"Description: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
description
, String
forall a. Monoid a => a
mempty
]
debianCompress :: BSL.ByteString -> BSL.ByteString
debianCompress :: ByteString -> ByteString
debianCompress = CompressParams -> ByteString -> ByteString
Gzip.compressWith CompressParams
Gzip.defaultCompressParams { compressLevel :: CompressionLevel
Gzip.compressLevel = CompressionLevel
Gzip.bestCompression }
gzipRules :: Rules ()
gzipRules :: Rules ()
gzipRules =
String
"//*.gz" Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let orig :: String
orig = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
out (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
stripExtension String
"gz" String
out
Located => [String] -> Action ()
[String] -> Action ()
need [String
orig]
ByteString
contents <- IO ByteString -> Action ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Action ByteString)
-> IO ByteString -> Action ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BSL.readFile String
orig
let zipped :: ByteString
zipped = ByteString -> ByteString
debianCompress ByteString
contents
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BSL.writeFile String
out ByteString
zipped
debRules :: Debian -> Rules ()
debRules :: Debian -> Rules ()
debRules Debian
deb = do
Rules ()
gzipRules
Text -> String
unpack (Debian -> Text
target Debian
deb) Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let binPerms :: FileMode
binPerms = FileMode
0o755
manPerms :: FileMode
manPerms = FileMode
0o0644
let binaries' :: [String]
binaries' = Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debian -> [Text]
binaries Debian
deb
libraries' :: [String]
libraries' = Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debian -> [Text]
libraries Debian
deb
headers' :: [String]
headers' = Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Debian -> [Text]
headers Debian
deb
([String] -> Action ()) -> [[String]] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Located => [String] -> Action ()
[String] -> Action ()
need [ [String]
binaries'
, [String]
libraries'
, [String]
headers'
]
let packDir :: String
packDir = Text -> String
unpack (Debian -> Text
package Debian
deb)
makeRel :: String -> String
makeRel = ((String
"target" String -> String -> String
</> String
packDir) String -> String -> String
</>)
debianDir :: String
debianDir = String -> String
makeRel String
"DEBIAN"
binDir :: String
binDir = String -> String
makeRel String
"usr/bin"
libDir :: String
libDir = String -> String
makeRel String
"usr/lib"
manDir :: String
manDir = String -> String
makeRel String
"usr/share/man/man1"
includeDir :: String
includeDir = String -> String
makeRel String
"usr/include"
docDir :: String
docDir = String -> String
makeRel (String
"usr/share/doc" String -> String -> String
</> String
packDir)
(String -> Action ()) -> [String] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\String
fp -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
fp FileMode
binPerms)
[String]
binaries'
let dirs :: [String]
dirs = [ String
binDir, String
debianDir, String
manDir, String
includeDir, String
docDir ]
(String -> Action ()) -> [String] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> (String -> IO ()) -> String -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> IO ()
createDirectoryIfMissing Bool
True) [String]
dirs
let parents :: [String]
parents = [ String
"usr", String
"usr/share/man", String
"usr/share", String
"usr/share/doc" ]
(String -> Action ()) -> [String] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\String
fp -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
fp FileMode
binPerms)
((String -> String
makeRel (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parents) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirs)
Maybe (Action ()) -> Action ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe (Action ()) -> Action ()) -> Maybe (Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ do
Text
mp <- Debian -> Maybe Text
manpage Debian
deb
Action () -> Maybe (Action ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Action () -> Maybe (Action ())) -> Action () -> Maybe (Action ())
forall a b. (a -> b) -> a -> b
$ do
let mp' :: String
mp' = Text -> String
unpack Text
mp String -> String -> String
<.> String
"gz"
Located => [String] -> Action ()
[String] -> Action ()
need [String
mp']
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> FileMode -> IO ()
setFileMode String
mp' FileMode
manPerms)
Located => String -> String -> Action ()
String -> String -> Action ()
copyFile' String
mp' (String
manDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
mp')
let moveFiles :: [String] -> String -> Action ()
moveFiles [String]
files String
dir = (String -> String -> Action ())
-> [String] -> [String] -> Action ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Located => String -> String -> Action ()
String -> String -> Action ()
copyFile' [String]
files ((String
dir String -> String -> String
</>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
files)
[String] -> String -> Action ()
moveFiles [String]
binaries' String
binDir
[String] -> String -> Action ()
moveFiles [String]
libraries' String
libDir
[String] -> String -> Action ()
moveFiles [String]
headers' String
includeDir
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Located) =>
String -> String -> m ()
writeFileChanged (String
debianDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/control") (Debian -> String
control Debian
deb)
[CmdOption] -> String -> [String] -> Action ()
forall r.
(Located, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [String -> CmdOption
Cwd String
"target"] String
"dpkg-deb" [String
"--build", String
packDir, String -> String
dropDirectory1 String
out]