mach

A work-in-progress implementation of make(1)

git clone https://git.8pit.net/mach.git

 1{-# LANGUAGE LambdaCase #-}
 2
 3module Mach.Util where
 4
 5import Data.List (elemIndices)
 6import qualified Mach.Types as T
 7import System.Environment (getEnvironment)
 8
 9-- Strip a file name extension (suffix) from a file name.
10stripSuffix :: FilePath -> String
11stripSuffix name =
12  let indices = elemIndices '.' name
13   in if null indices
14        then name
15        else take (last indices) name
16
17-- | Like 'find', but allows the predicate to run in a monadic context
18-- and, furthermore, enables the predicate to compute some additional
19-- information.
20--
21-- Inspired by https://hackage.haskell.org/package/extra-1.7.14/docs/Control-Monad-Extra.html#v:firstJustM
22firstJustM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
23firstJustM _ [] = pure Nothing
24firstJustM p (x : xs) = do
25  p x >>= \case
26    Just y -> pure $ Just y
27    Nothing -> firstJustM p xs
28
29-- Returns true if the target name is a special target.
30isSpecial :: String -> Bool
31isSpecial = flip elem special
32  where
33    special :: [String]
34    special =
35      [ ".DEFAULT",
36        ".IGNORE",
37        ".PHONY",
38        ".NOTPARALLEL",
39        ".POSIX",
40        ".PRECIOUS",
41        ".SILENT",
42        ".SUFFIXES",
43        ".WAIT"
44      ]
45
46-- Returns environment variables as macro assignments.
47getEnvMarcos :: IO T.MkFile
48getEnvMarcos = do
49  env <- filter ((not . flip elem excluded) . fst) <$> getEnvironment
50  pure $ map (\(k, v) -> T.MkAssign $ T.Assign (T.Lit k) T.Immediate (T.Lit v)) env
51  where
52    excluded :: [String]
53    excluded = ["SHELL", "MAKEFLAGS"]