Main.hs

module Main where

import Control.Arrow
import Control.Monad
import Control.Exception
import Data.List

import System.Environment
import System.Process
import System.Exit
import System.IO
import System.Directory
import System.Process

import System.FilePath
import System.FilePath.Wrapper (FileT(..))
import Development.Cake3.Utils.Find

import Text.Printf

filterCakes :: FilePath -> Bool
filterCakes x = nodots && isPrefixOf "Cake" bn &&  isSuffixOf ".hs" bn where
  bn = takeFileName x
  nodots = all (not . isPrefixOf ".") $ skipRelativeDot $ splitDirectories x
  skipRelativeDot (".":ds) = ds
  skipRelativeDot x = x

pathOrder :: FilePath -> FilePath -> Ordering
pathOrder a b =
  let
    na = normalise a
    nb = normalise b
    la = length (splitDirectories na)
    lb = length (splitDirectories nb)
    x = compare la lb
  in
    case x of
      EQ -> compare na nb
      _ -> x

nameOrder :: FilePath -> FilePath -> Ordering
nameOrder a b = takeFileName a `compare` takeFileName b

checkCakeGroupAgainstGit :: [FilePath] -> IO (Either String (String,FilePath))
checkCakeGroupAgainstGit cakes = do
  cwd <- getCurrentDirectory
  revs <- forM cakes $ \c -> do
    bracket (setCurrentDirectory (takeDirectory c)) (const (setCurrentDirectory cwd)) $ \ () -> do
      return ("ACAACACACACACACACACAACACACA", c)
  return $
    foldl' (\err (r',c') ->
      case err of
        Left x -> Left x
        Right (r,c) ->
          case r == r' of
            True -> Right (r,c)
            False -> Left (printf "Git revision for %s (%s) doesn't match the one for %s (%s)" c' r' c r)
    ) (Left "empty list") revs

main :: IO ()
main = do
  fs <- map (sortBy pathOrder) <$> groupBy (curry ((EQ==) . uncurry nameOrder)) <$> sortBy nameOrder <$> filter filterCakes <$> getDirectoryContentsRecursive' "."

  forM_ fs $ \x -> do
    putStrLn (show x)

  return ()