diff options
-rw-r--r-- | fsmgr.cabal | 2 | ||||
-rw-r--r-- | fsmgr.hs | 42 | ||||
-rw-r--r-- | src/String.hs | 44 |
3 files changed, 48 insertions, 40 deletions
diff --git a/fsmgr.cabal b/fsmgr.cabal index 7f7708d..4d2de80 100644 --- a/fsmgr.cabal +++ b/fsmgr.cabal | |||
@@ -19,7 +19,7 @@ source-repository head | |||
19 | 19 | ||
20 | library | 20 | library |
21 | exposed-modules: | 21 | exposed-modules: |
22 | Crypto.Hash.Types.Digest.Read, ConfigFile | 22 | Crypto.Hash.Types.Digest.Read, ConfigFile, String |
23 | other-modules: | 23 | other-modules: |
24 | Paths_fsmgr | 24 | Paths_fsmgr |
25 | hs-source-dirs: | 25 | hs-source-dirs: |
@@ -27,56 +27,20 @@ import System.Directory (getCurrentDirectory, createDirectoryIfMissing) | |||
27 | import System.Posix.Process (getProcessID) | 27 | import System.Posix.Process (getProcessID) |
28 | import System.Posix.Types (CUid (..)) | 28 | import System.Posix.Types (CUid (..)) |
29 | import System.Posix.User (getEffectiveUserID) | 29 | import System.Posix.User (getEffectiveUserID) |
30 | import String | ||
30 | 31 | ||
31 | noParent :: BaseImageSpecification -> Bool | 32 | noParent :: BaseImageSpecification -> Bool |
32 | noParent (EmptyImageOfBytes _) = True | 33 | noParent (EmptyImageOfBytes _) = True |
33 | noParent (ParentImageConfigFile _) = False | 34 | noParent (ParentImageConfigFile _) = False |
34 | 35 | ||
35 | split :: Eq a => [a] -> [a] -> [[a]] | 36 | dynamicNames :: FilePath -> FilePath |
36 | split _ [] = [] | 37 | dynamicNames = replace "$(karch)" uname |
37 | split delim str = | ||
38 | let (firstline, remainder) = breakList (startswith delim) str | ||
39 | in | ||
40 | firstline : case remainder of | ||
41 | [] -> [] | ||
42 | x -> if x == delim | ||
43 | then [] : [] | ||
44 | else split delim | ||
45 | (drop (length delim) x) | ||
46 | |||
47 | spanList :: ([a] -> Bool) -> [a] -> ([a], [a]) | ||
48 | spanList _ [] = ([],[]) | ||
49 | spanList func list@(x:xs) = | ||
50 | if func list | ||
51 | then (x:ys,zs) | ||
52 | else ([],list) | ||
53 | where (ys,zs) = spanList func xs | ||
54 | |||
55 | breakList :: ([a] -> Bool) -> [a] -> ([a], [a]) | ||
56 | breakList func = spanList (not . func) | ||
57 | |||
58 | startswith :: Eq a => [a] -> [a] -> Bool | ||
59 | startswith = isPrefixOf | ||
60 | |||
61 | join :: [a] -> [[a]] -> [a] | ||
62 | join delim l = concat (intersperse delim l) | ||
63 | |||
64 | replace :: Eq a => [a] -> [a] -> [a] -> [a] | ||
65 | replace old new l = join new . split old $ l | ||
66 | |||
67 | wordsBy c s = words (rep <$> s) | ||
68 | where | ||
69 | rep x | x == c = ' ' | ||
70 | | otherwise = x | ||
71 | 38 | ||
72 | uname :: String | 39 | uname :: String |
73 | uname = unsafePerformIO $ do | 40 | uname = unsafePerformIO $ do |
74 | Stdout out <- cmd "uname -r" | 41 | Stdout out <- cmd "uname -r" |
75 | return $ last . wordsBy '-' . head . lines $ out | 42 | return $ last . wordsBy '-' . head . lines $ out |
76 | 43 | ||
77 | dynamicNames :: FilePath -> FilePath | ||
78 | dynamicNames = replace "$(karch)" uname | ||
79 | |||
80 | buildRoot :: DiskImageConfig -> FilePath -> Action () | 44 | buildRoot :: DiskImageConfig -> FilePath -> Action () |
81 | buildRoot config@DiskImageConfig{..} finalOut = do | 45 | buildRoot config@DiskImageConfig{..} finalOut = do |
82 | let out = finalOut <.> "tmp" | 46 | let out = finalOut <.> "tmp" |
diff --git a/src/String.hs b/src/String.hs new file mode 100644 index 0000000..633c920 --- /dev/null +++ b/src/String.hs | |||
@@ -0,0 +1,44 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | |||
3 | module String where | ||
4 | |||
5 | import Rebase.Prelude hiding (bool, hash, join, o, (<.>)) | ||
6 | |||
7 | split :: Eq a => [a] -> [a] -> [[a]] | ||
8 | split _ [] = [] | ||
9 | split delim str = | ||
10 | let (firstline, remainder) = breakList (startswith delim) str | ||
11 | in | ||
12 | firstline : case remainder of | ||
13 | [] -> [] | ||
14 | x -> if x == delim | ||
15 | then [] : [] | ||
16 | else split delim | ||
17 | (drop (length delim) x) | ||
18 | |||
19 | spanList :: ([a] -> Bool) -> [a] -> ([a], [a]) | ||
20 | spanList _ [] = ([],[]) | ||
21 | spanList func list@(x:xs) = | ||
22 | if func list | ||
23 | then (x:ys,zs) | ||
24 | else ([],list) | ||
25 | where (ys,zs) = spanList func xs | ||
26 | |||
27 | breakList :: ([a] -> Bool) -> [a] -> ([a], [a]) | ||
28 | breakList func = spanList (not . func) | ||
29 | |||
30 | startswith :: Eq a => [a] -> [a] -> Bool | ||
31 | startswith = isPrefixOf | ||
32 | |||
33 | join :: [a] -> [[a]] -> [a] | ||
34 | join delim l = concat (intersperse delim l) | ||
35 | |||
36 | replace :: Eq a => [a] -> [a] -> [a] -> [a] | ||
37 | replace old new l = join new . split old $ l | ||
38 | |||
39 | wordsBy :: Char -> [Char] -> [String] | ||
40 | wordsBy c s = words (rep <$> s) | ||
41 | where | ||
42 | rep x | x == c = ' ' | ||
43 | | otherwise = x | ||
44 | |||