{-# 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]
                     , Debian -> [Text]
headers     :: [Text]
                     , Debian -> Maybe Text
license     :: Maybe Text
                     , Debian -> Maybe Text
changelog   :: Maybe Text
                     }
                     -- TODO: section https://www.debian.org/doc/debian-policy/ch-archive.html#s-subsections
                     -- TODO: priority https://www.debian.org/doc/debian-policy/ch-archive.html#s-priorities
                     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


-- look at hackage package for debian?
debRules :: Debian -> Rules ()
debRules :: Debian -> Rules ()
debRules Debian
deb = do

    Rules ()
gzipRules -- TODO: right place?

    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]