diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,6 +4,7 @@ ) where import Control.Composition +import Control.Lens hiding (List, argument) import Control.Monad import Data.Bool (bool) import Data.Maybe (fromMaybe) @@ -13,7 +14,6 @@ import Development.Shake.ATS import Development.Shake.FilePath import Language.ATS.Package -import Lens.Micro import Options.Applicative import System.Directory import System.IO.Temp (withSystemTempDirectory) diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,12 +1,13 @@ cabal-version: 1.18 name: ats-pkg -version: 2.10.0.2 +version: 2.10.0.8 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale maintainer: vamchale@gmail.com author: Vanessa McHale homepage: https://github.com/vmchale/atspkg#readme +bug-reports: https://github.com/vmchale/atspkg/issues synopsis: A build tool for ATS description: A collection of scripts to simplify building ATS projects. @@ -58,12 +59,13 @@ Language.ATS.Package.PackageSet Language.ATS.Package.Type Language.ATS.Package.Upgrade + Language.ATS.Package.Debian Distribution.ATS.Version System.Process.Ext Quaalude default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns - -Wincomplete-record-updates -Wcompat + -Wincomplete-record-updates build-depends: base >=4.11 && <5, http-client -any, @@ -83,8 +85,6 @@ containers -any, parallel-io -any, unix -any, - microlens -any, - microlens-th -any, mtl -any, dhall >=1.11.0 && <=1.12.0, ansi-wl-pprint -any, @@ -94,6 +94,7 @@ zip-archive -any, ansi-wl-pprint -any, binary -any, + lens, dependency -any, filemanip -any @@ -107,15 +108,15 @@ Paths_ats_pkg default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat + -Wincomplete-uni-patterns -Wincomplete-record-updates if !flag(no-executable) build-depends: base -any, ats-pkg -any, optparse-applicative -any, - microlens -any, shake-ats -any, + lens, temporary -any, directory -any, composition-prelude -any, diff --git a/src/Distribution/ATS/Build.hs b/src/Distribution/ATS/Build.hs --- a/src/Distribution/ATS/Build.hs +++ b/src/Distribution/ATS/Build.hs @@ -48,5 +48,5 @@ -- ATS library. cabalHooks :: UserHooks cabalHooks = let defConf = confHook simpleUserHooks - in simpleUserHooks { preConf = \_ _ -> writeDummyFile >> pure emptyHookedBuildInfo + in simpleUserHooks { preConf = (writeDummyFile >>) .* preConf simpleUserHooks , confHook = configureCabal .* defConf } diff --git a/src/Language/ATS/Package/Build.hs b/src/Language/ATS/Package/Build.hs --- a/src/Language/ATS/Package/Build.hs +++ b/src/Language/ATS/Package/Build.hs @@ -23,6 +23,7 @@ import Language.ATS.Package.Build.C import Language.ATS.Package.Compiler import Language.ATS.Package.Config +import Language.ATS.Package.Debian hiding (libraries, target) import Language.ATS.Package.Dependency import Language.ATS.Package.Type import Quaalude @@ -165,7 +166,7 @@ -> [(Rebuild, String)] rebuildTargets rba rs = foldMap g [ (rba, (RebuildNow ,) <$> patterns rs) ] where g (b, ts) = bool mempty ts b - patterns = thread (mkPattern <$> ["c", "o", "so", "a"]) + patterns = thread (mkPattern <$> ["c", "o", "so", "a", "deb"]) mkPattern ext = ("//*." <> ext :) cleanConfig :: (MonadIO m) => [String] -> m Pkg @@ -224,7 +225,7 @@ subdirs <- (p:) <$> allSubdirs p pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" let installDir = takeDirectory pkgPath - build' installDir tgt' mempty + build' installDir tgt' ["install"] -- | The directory @~/.atspkg@ pkgHome :: MonadIO m => CCompiler -> m String @@ -251,7 +252,7 @@ -> Maybe String -- ^ Optional compiler triple (overrides 'ccompiler') -> Pkg -- ^ Package data type -> Rules () -pkgToAction setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf as dl slv) = +pkgToAction setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf as dl slv deb) = unless (rs == ["clean"]) $ do @@ -264,6 +265,7 @@ specialDeps %> \out -> do (_, cfgBin') <- cfgBin need [ cfgBin', ".atspkg/config" ] + -- TODO use an oracle here liftIO $ fetchDeps (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False >> writeFile out "" let bins = unpack . target <$> bs @@ -276,6 +278,8 @@ mapM_ (h ph) lbs mapM_ (g ph) (bs ++ ts) + + fold (debRules <$> deb) where g ph (Bin s t ls hs' atg gc' extra) = atsBin (ATSTarget (unpack <$> cf) (atsToolConfig ph) gc' (unpack <$> ls) [unpack s] hs' (unpackTgt <$> atg) mempty (unpack t) (deps extra) Executable True) diff --git a/src/Language/ATS/Package/Debian.hs b/src/Language/ATS/Package/Debian.hs new file mode 100644 --- /dev/null +++ b/src/Language/ATS/Package/Debian.hs @@ -0,0 +1,75 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Language.ATS.Package.Debian ( debRules + , Debian (..) + ) where + +import Data.Dependency (Version (..)) +import Data.Hashable (Hashable) +import Data.List (intercalate) +import Data.Text.Lazy (Text) +import Development.Shake +import Development.Shake.FilePath +import Dhall +import Quaalude + +data Debian = Debian { package :: Text + , version :: Version + , maintainer :: Text + , description :: Text + , target :: Text + , manpage :: Maybe Text + , binaries :: [Text] + , libraries :: [Text] + } + deriving (Generic, Hashable, Binary, Interpret) + +deriving newtype instance Interpret Version +deriving newtype instance Hashable Version + +control :: Debian -> String +control Debian{..} = intercalate "\n" + [ "Package: " ++ unpack package + , "Version: " ++ show version + , "Architecture: all" + , "Maintainer: " ++ unpack maintainer + , "Description: " ++ unpack description + , mempty + ] + +-- look at hackage package for debian? +debRules :: Debian -> Rules () +debRules deb = + unpack (target deb) %> \out -> do + + need (unpack <$> binaries deb) + + let packDir = unpack (package deb) + makeRel = (("target/" ++ packDir ++ "/") ++) + debianDir = makeRel "/DEBIAN" + binDir = makeRel "/usr/local/bin" + libDir = makeRel "/usr/local/lib" + manDir = makeRel "/usr/local/share/man/man1" + + mapM_ (liftIO . createDirectoryIfMissing True) + [ binDir, debianDir, manDir ] + + fold $ do + mp <- manpage deb + pure $ + need [unpack mp] >> + copyFile' (unpack mp) (manDir ++ "/" ++ takeFileName (unpack mp)) + + zipWithM_ copyFile' (unpack <$> binaries deb) (((binDir ++ "/") ++) . unpack <$> binaries deb) + zipWithM_ copyFile' (unpack <$> libraries deb) (((libDir ++ "/") ++) . unpack <$> libraries deb) + + writeFileChanged (debianDir ++ "/control") (control deb) + + command [Cwd "target"] "dpkg-deb" ["--build", packDir, dropDirectory1 out] diff --git a/src/Language/ATS/Package/Dependency.hs b/src/Language/ATS/Package/Dependency.hs --- a/src/Language/ATS/Package/Dependency.hs +++ b/src/Language/ATS/Package/Dependency.hs @@ -49,8 +49,6 @@ atsDeps' <- setBuildPlan "atsbld" libBldDeps pkgSet atsBld cdeps' <- setBuildPlan "c" libDeps pkgSet cdeps - -- ~/.atspkg/0.3.10/lib/ats2-postiats-0.3.9/c - -- Set up actions d <- (<> "lib/") <$> cpkgHome cc' let tgt' = getTgt cc' diff --git a/src/Language/ATS/Package/Type.hs b/src/Language/ATS/Package/Type.hs --- a/src/Language/ATS/Package/Type.hs +++ b/src/Language/ATS/Package/Type.hs @@ -28,8 +28,9 @@ ) where import Data.Dependency -import Data.Hashable (Hashable) +import Data.Hashable (Hashable) import Development.Shake.ATS +import Language.ATS.Package.Debian import Quaalude data ATSConstraint = ATSConstraint { lower :: Maybe Version @@ -38,8 +39,6 @@ deriving (Eq, Show, Generic, Binary, Interpret, Hashable) deriving newtype instance Inject Version -deriving newtype instance Interpret Version -deriving newtype instance Hashable Version type LibDep = (Text, ATSConstraint) @@ -121,5 +120,6 @@ , atsSource :: [Src] -- ^ ATS source to be compile to C. , dynLink :: Bool -- ^ Don't link statically, instead, use libraries installed by @atspkg@. , extSolve :: Solver -- ^ Solver to use. + , debPkg :: Maybe Debian -- ^ Optional specificiation as a debian package. } deriving (Generic, Interpret, Binary, Hashable) diff --git a/src/Quaalude.hs b/src/Quaalude.hs --- a/src/Quaalude.hs +++ b/src/Quaalude.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Quaalude ( hex , bool , intersperse @@ -115,6 +117,7 @@ import Control.Arrow hiding ((<+>)) import Control.Composition +import Control.Lens hiding (both) import Control.Monad import Control.Monad.IO.Class import Data.Binary @@ -128,9 +131,6 @@ import Development.Shake hiding (getEnv) import Development.Shake.FilePath import Dhall hiding (bool) -import Lens.Micro hiding (both) -import Lens.Micro.Extras -import Lens.Micro.TH import Network.HTTP.Client import Network.HTTP.Client.TLS (tlsManagerSettings) import Numeric (showHex) @@ -140,12 +140,18 @@ import System.Posix.Files import System.Process as X import System.Process.Ext -import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<>)) +import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<$>), (<>)) infixr 5 <#> hex :: Int -> String hex = flip showHex mempty + +instance Semigroup a => Semigroup (Action a) where + (<>) a b = (<>) <$> a <*> b + +instance Monoid a => Monoid (Action a) where + mempty = pure mempty -- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the -- prelude.