Java/ClassPath/Common.hs

   1
   2 module Java.ClassPath.Common where
   3
   4 import Data.List
   5 import Data.String.Utils (split)
   6 import System.FilePath
   7
   8 import Java.ClassPath.Types
   9
  10 -- | map on forest
  11 mapF ::  (t -> a) -> [Tree t] -> [Tree a]
  12 mapF fn forest = map (mapT fn) forest
  13
  14 -- | mapM on forest
  15 mapFM :: (Monad m, Functor m) => (t -> m a) -> [Tree t] -> m [Tree a]
  16 mapFM fn forest = mapM (mapTM fn) forest
  17
  18 -- | mapM on tree
  19 mapTM ::  (Monad m, Functor m) => (t -> m a) -> Tree t -> m (Tree a)
  20 mapTM fn (Directory dir forest) = Directory dir `fmap` mapFM fn forest
  21 mapTM fn (File a) = File `fmap` fn a
  22
  23 mapFMF ::  (Monad m, Functor m) => (FilePath -> t -> m a) -> [Tree t] -> m [Tree a]
  24 mapFMF fn forest = mapM (mapTMF fn) forest
  25
  26 mapTMF ::  (Monad m, Functor m) => (FilePath -> t -> m a) -> Tree t -> m (Tree a)
  27 mapTMF fn t = go "" t
  28   where
  29     go path (Directory dir forest) = Directory dir `fmap` mapM (go $ path </> dir) forest
  30     go path (File a) = File `fmap` fn path a
  31
  32 -- | map on tree
  33 mapT ::  (t -> a) -> Tree t -> Tree a
  34 mapT fn (Directory dir forest) = Directory dir (mapF fn forest)
  35 mapT fn (File a) = File (fn a)
  36
  37 -- | Build tree from list of filenames.
  38 -- For example, ["org/haskell", "org/java"] --> [org/{haskell, java}]
  39 buildTree :: [FilePath] -> [Tree FilePath]
  40 buildTree strs =
  41   let build :: [[String]] -> [Tree FilePath]
  42       build [[name]] = [File name]
  43       build ss = map node $ groupBy eq (sort ss)
  44
  45       node [] = error "Impossible: groupBy give an empty group!"
  46       node ([]:l) = node l
  47       node l | all (null . tail) l = File (head $ head l)
  48              | otherwise           = Directory (head $ head l) (build $ map tail l)
  49
  50       ls = map (split "/") strs
  51
  52       eq [] []       = True
  53       eq (x:_) (y:_) = x == y
  54
  55   in  build ls
  56
  57 -- | Merge ClassPath forest.
  58 -- For example, [org/haskell, org/java] --> [org/{haskell, java}].
  59 merge :: [Tree CPEntry] -> [Tree CPEntry]
  60 merge [] = []
  61 merge [t1,t2] = merge1 [t1] t2
  62 merge (t:ts) = foldl merge1 [t] ts
  63
  64 -- | Add one ClassPath tree to forest.
  65 merge1 :: [Tree CPEntry] -> Tree CPEntry -> [Tree CPEntry]
  66 merge1 [] x = [x]
  67 merge1 (x@(File e): es) y@(File e') | e == e'   = x: es
  68                                     | otherwise = x: merge1 es y
  69 merge1 (d@(Directory _ _):es) f@(File _) = d: merge1 es f
  70 merge1 (f@(File _):es) d@(Directory _ _) = f: merge1 es d
  71 merge1 (x@(Directory dir f):es) y@(Directory dir' f')
  72   | dir == dir' = Directory dir (merge $ f ++ f'): es
  73   | otherwise   = x: merge1 es y
  74