enable $(karch) in package names

1 files changed, 47 insertions, 2 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index 884ca22..66bcaa8 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -10,7 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 
 module Main where
-import Rebase.Prelude hiding (bool, hash, o, (<.>))
+import Rebase.Prelude hiding (bool, hash, o, (<.>), join)
 
 import qualified Rebase.Data.Text as Text
          ;import Rebase.Data.Text (pack, unpack)
@@ -32,6 +32,51 @@ noParent :: BaseImageSpecification -> Bool
 noParent (EmptyImageOfBytes _)     = True
 noParent (ParentImageConfigFile _) = False
 
+split :: Eq a => [a] -> [a] -> [[a]]
+split _ [] = []
+split delim str =
+    let (firstline, remainder) = breakList (startswith delim) str
+        in
+        firstline : case remainder of
+                                   [] -> []
+                                   x -> if x == delim
+                                        then [] : []
+                                        else split delim
+                                                 (drop (length delim) x)
+
+spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
+spanList _ [] = ([],[])
+spanList func list@(x:xs) =
+    if func list
+       then (x:ys,zs)
+       else ([],list)
+    where (ys,zs) = spanList func xs
+
+breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
+breakList func = spanList (not . func)
+
+startswith :: Eq a => [a] -> [a] -> Bool
+startswith = isPrefixOf
+
+join :: [a] -> [[a]] -> [a]
+join delim l = concat (intersperse delim l)
+
+replace :: Eq a => [a] -> [a] -> [a] -> [a]
+replace old new l = join new . split old $ l
+
+wordsBy c s = words (rep <$> s)
+  where
+    rep x | x == c    = ' '
+          | otherwise = x
+
+uname :: String
+uname = unsafePerformIO $ do
+  Stdout out <- cmd "uname -r"
+  return $ last . wordsBy '-' . head . lines $ out
+
+dynamicNames :: FilePath -> FilePath
+dynamicNames = replace "$(karch)" uname
+
 buildRoot :: DiskImageConfig -> FilePath -> Action ()
 buildRoot config@DiskImageConfig{..} finalOut = do
   let out        = finalOut <.> "tmp"
@@ -55,7 +100,7 @@ buildRoot config@DiskImageConfig{..} finalOut = do
       -- When there is no parent, selfstrap should install packages marked
       -- "Required" even if no packages are specified. When there is a parent,
       -- assume that this has already happened.
-      cmd_ "selfstrap" (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames
+      cmd_ "selfstrap" (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) (dynamicNames <$> packageNames)
     when (not $ null debs) $ do
       cmd_ (AddEnv "DEBIAN_FRONTEND" "noninteractive")
            ["dpkg"] [if unpackOnly then "--unpack" else "--install"] debs