add support for installing from .deb files

also misc. improvements

1 files changed, 24 insertions, 19 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index 0c4bfe2..f144e0f 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -1,13 +1,11 @@
-{-# LANGUAGE ScopedTypeVariables   #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
-{-# LANGUAGE ExtendedDefaultRules  #-}
-{-# LANGUAGE InstanceSigs          #-}
-{-# LANGUAGE NamedFieldPuns        #-}
-{-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE NamedFieldPuns       #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RecordWildCards      #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+
 module Main where
 import Rebase.Prelude hiding (bool, hash, (<.>))
 
@@ -101,14 +99,26 @@ buildRoot DiskImageConfig{..} finalOut = do
       cmd_ "mkfs.btrfs" [out]
       cmd_ "mkdir -p" [mountpoint]
       cmd_ "mount -t btrfs" [out] mountpoint
+
+      -- create new default subvolume, and then remount with it
       createDefaultSubvolume mountpoint
-      cmd_ (Cwd mountpoint) "mkdir -p root/var/cache/apt"
-      cmd_ (Cwd mountpoint) "btrfs subvolume create root/var/cache/apt/archives"
+      cmd_ "umount" [mountpoint]
+      cmd_ "mount -t btrfs" [out, mountpoint]
+
+      cmd_ (Cwd mountpoint) "mkdir -p var/cache/apt"
+      cmd_ (Cwd mountpoint) "btrfs subvolume create var/cache/apt/archives"
+
   -- TODO: catch errors and umount, rmdir mountpoint
+  let (debs, packageNames) = partitionPackages $ unpack . coerce <$> toList packages
   cmd_ "selfstrap --skip-update"
-    (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) (unpack . coerce <$> toList packages)
+    (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames
+  forM_ debs $ \pkg -> do
+    cmd_ "dpkg -i --root" [mountpoint, pkg]
   cmd_ "mv" [out, finalOut]
 
+partitionPackages :: [String] -> ([String], [String])
+partitionPackages = partition (elem '/')
+
 consWhen :: a -> Bool -> [a] -> [a]
 a `consWhen` c = if c then (a:) else id
 
@@ -161,10 +171,5 @@ shakeRules = do
     buildRoot cfg out
 
   "*.btrfs" %> \out -> do
-    orderOnly ["_build/" ++ out]
-    cmd_ "cp --reflink=always -i" ["_build/" ++ out, out]
-
-
-  -- "_build/" ++ targetFilename %> \out -> do
-  --   needParent targetConfig
-  --   return ()
+    orderOnly ["_build" </> out]
+    cmd_ "cp --reflink=always -i" ["_build" </> out, out]