Add some globbing for copying files.

MicroCabal.cabal

@@ -26,13 +26,15 @@ executable mcabal
   hs-source-dirs:      src
   ghc-options:         -Wall -Wno-unrecognised-warning-flags -Wno-x-partial -main-is MicroCabal.Main
   main-is:             MicroCabal/Main.hs
-  default-extensions:  MultiParamTypeClasses
+  default-extensions:  MultiParamTypeClasses ScopedTypeVariables PatternGuards
   other-modules:       MicroCabal.Backend.GHC
                        MicroCabal.Backend.MHS
                        MicroCabal.Cabal
                        MicroCabal.Env
+                       MicroCabal.Glob
                        MicroCabal.Normalize
                        MicroCabal.Parse
+                       MicroCabal.Regex
                        MicroCabal.StackageList
                        MicroCabal.Unix
                        MicroCabal.YAML

src/MicroCabal/Glob.hs

@@ -0,0 +1,45 @@
+module MicroCabal.Glob(
+  GlobPattern,
+  --glob,
+  listDirectoryRecursive,
+  matchFiles,
+  ) where
+import Control.Exception
+import Control.Monad
+import System.Directory
+import MicroCabal.Regex
+import MicroCabal.Unix((</>))
+
+-- A glob pattern can contain:
+--  *   - any number of file name characters, except /
+--  **  - any number of file name characters
+--  X   - anything else is a character that just matches itself
+type GlobPattern = String
+
+{-
+glob :: GlobPattern -> [String] -> [String]
+glob p ss =
+  let r = globToRegex p
+  in  filter (regexMatch r) ss
+-}
+
+globToRegex :: GlobPattern -> Regex
+globToRegex [] = eps
+globToRegex ('*':'*':cs) = Star (Lit (Neg "")) `Seq` globToRegex cs
+globToRegex ('*':cs) = Star (Lit (Neg "/")) `Seq` globToRegex cs
+globToRegex (c:cs) = Lit (Pos [c]) `Seq` globToRegex cs
+
+-- Recursively find all files in the given directory.
+listDirectoryRecursive :: FilePath -> IO [FilePath]
+listDirectoryRecursive ".git" = return []  -- Hack to avoid the gazillion files in .git/
+listDirectoryRecursive x = do
+  xs <- listDirectory x `catch` (\ (_ :: SomeException) -> return [])
+  concat <$> (forM xs $ \ y -> (y:) <$> fmap (y </>) <$> listDirectoryRecursive (x </> y))
+
+matchFiles :: FilePath -> [GlobPattern] -> IO [FilePath]
+matchFiles dir pats = do
+  fs <- listDirectoryRecursive dir
+  let select pat =
+        let re = globToRegex pat
+        in  filter (regexMatch re) fs
+  pure $ concatMap select pats

src/MicroCabal/Main.hs

@@ -12,6 +12,7 @@ import MicroCabal.Backend.GHC
 import MicroCabal.Backend.MHS
 import MicroCabal.Cabal
 import MicroCabal.Env
+import MicroCabal.Glob
 import MicroCabal.Normalize
 import MicroCabal.Parse
 import MicroCabal.StackageList
@@ -315,9 +316,14 @@ installLib env glob sect@(Section _ name _) = do
   installPkgLib (backend env) env glob sect
 
 installDataFiles :: Env -> Section -> Section -> IO ()
-installDataFiles _env _glob _sect@(Section _ _ _flds) = do
-  -- Not yet
-  return ()
+installDataFiles env _glob _sect@(Section _ _ flds) = do
+  case getFieldStrings flds [] "data-files" of
+    [] -> return ()
+    pats -> do
+      files <- matchFiles "." pats
+      message env 1 $ "Installing data files " ++ unwords files
+      let tgt = undefined
+      copyFiles env "." files tgt
 
 -----------------------------------------
 

src/MicroCabal/Regex.hs

@@ -0,0 +1,101 @@
+-- Originally stolen from https://crypto.stanford.edu/~blynn/haskell/re.html
+
+-- Regular expression matching using Brzozowski's algorithm
+module MicroCabal.Regex(CharClass(..), Regex(..), eps, regexMatch) where
+import Data.List(sort, nub)
+
+data CharClass = Pos String | Neg String
+  deriving (Eq, Ord, Show)
+
+elemCC :: Char -> CharClass -> Bool
+elemCC c (Pos cs) = c `elem` cs
+elemCC c (Neg cs) = c `notElem` cs
+
+data Regex
+  = Lit CharClass
+  | Seq Regex Regex
+  | Star Regex
+  | Or [Regex]
+  | And [Regex]
+  | Not Regex
+  deriving (Eq, Ord, Show)
+
+regexMatch :: Regex -> String -> Bool
+regexMatch re ""    = nullable re
+regexMatch re (c:s) = regexMatch (derive c re) s
+
+-- The regex `()`. The language containing only the empty string.
+eps :: Regex
+eps = Star noGood
+
+-- The regex `[]`. The empty language.
+noGood :: Regex
+noGood = Lit $ Pos []
+
+-- The regex `.*`. The language containing everything.
+allGood :: Regex
+allGood = Star $ Lit $ Neg []
+
+nullable :: Regex -> Bool
+nullable re =
+  case re of
+    Lit _   -> False
+    Star _  -> True
+    Seq r s -> nullable r && nullable s
+    Or  rs  -> any nullable rs
+    And rs  -> all nullable rs
+    Not r   -> not $ nullable r
+
+derive :: Char -> Regex -> Regex
+derive c re =
+  case re of
+    Lit cc | elemCC c cc   -> eps
+           | otherwise     -> noGood
+    Star r                 -> derive c r `mkSeq` mkStar r
+    r `Seq` s | nullable r -> mkOr [derive c r `mkSeq` s, derive c s]
+              | otherwise  -> derive c r `mkSeq` s
+    And rs                 -> mkAnd $ map (derive c) rs
+    Or  rs                 -> mkOr  $ map (derive c) rs
+    Not r                  -> mkNot $ derive c r
+
+-- Smart constructors
+mkSeq :: Regex -> Regex -> Regex
+mkSeq r s
+  | r == noGood || s == noGood = noGood
+  | r == eps       = s
+  | s == eps       = r
+  | x `Seq` y <- r = x `mkSeq` (y `mkSeq` s)
+  | otherwise      = r `Seq` s
+
+mkOr :: [Regex] -> Regex
+mkOr xs
+  | allGood `elem` zs = allGood
+  | null zs           = noGood
+  | [z] <- zs         = z
+  | otherwise         = Or zs
+  where
+    zs = nub $ sort $ filter (/= noGood) flat
+    flat           = concatMap deOr xs
+    deOr (Or rs)   = rs
+    deOr r         = [r]
+
+mkAnd :: [Regex] -> Regex
+mkAnd xs
+  | noGood `elem` zs = noGood
+  | null zs          = allGood
+  | [z] <- zs        = z
+  | otherwise        = And zs
+  where
+    zs = nub $ sort $ filter (/= allGood) flat
+    flat             = concatMap deAnd xs
+    deAnd (And rs)   = rs
+    deAnd r          = [r]
+
+mkStar :: Regex -> Regex
+mkStar (Star s) = mkStar s
+mkStar r        = Star r
+
+mkNot :: Regex -> Regex
+mkNot (Lit (Pos [])) = allGood
+mkNot (Not s)        = s
+mkNot r              = Not r