    -- Copyright (C) 2005 David Roundy
    --
    -- This program is free software; you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation; either version 2, or (at your option)
    -- any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program; see the file COPYING.  If not, write to
    -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    -- Boston, MA 02110-1301, USA.

    {-# OPTIONS_GHC -cpp #-}
    {-# LANGUAGE CPP #-}

    module Darcs.FilePathMonad ( FilePathMonad, withFilePaths ) where

    import Control.Monad ( MonadPlus, mplus, mzero )
    import Data.Maybe ( catMaybes )

    import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )
    import Darcs.Patch.FileName ( FileName, fp2fn, fn2fp, superName, break_on_dir,
                                  norm_path, movedirfilename )
    #include "impossible.h"

    data FilePathMonad a = FPM ([FileName] -> ([FileName], a))

    withFilePaths :: [FilePath] -> FilePathMonad a -> [FilePath]
    withFilePaths fps (FPM x) = map fn2fp $ fst $ x $ map fp2fn fps

    instance Functor FilePathMonad where
        fmap f m = m >>= return . f

    instance Monad FilePathMonad where
        (FPM x) >>= y = FPM z where z fs = case x fs of
                                           (fs', a) -> case y a of
                                                       FPM yf -> yf fs'
        return x = FPM $ \fs -> (fs, x)

    instance MonadPlus FilePathMonad where
        mzero = fail "mzero FilePathMonad" -- yuck!
        a `mplus` _ = a

    instance ReadableDirectory FilePathMonad where
        -- We can't check it actually is a directory here
        mDoesDirectoryExist d =
            FPM $ \fs -> (fs, norm_path d `elem` map norm_path fs)
        -- We can't check it actually is a file here
        mDoesFileExist f =
            FPM $ \fs -> (fs, norm_path f `elem` map norm_path fs)
        mInCurrentDirectory d (FPM j) =
            FPM $ \fs -> (fs, snd $ j $ catMaybes $ map indir fs)
            where indir f = do (d',f') <- break_on_dir f
                               if d == d' then Just f'
                                          else Nothing
        mGetDirectoryContents =
            FPM $ \fs -> (fs, filter (\f -> fp2fn "." == superName f) fs)
        mReadFilePS = bug "can't mReadFilePS in FilePathMonad!"

    instance WriteableDirectory FilePathMonad where
        mWithCurrentDirectory d (FPM j) =
            FPM $ \fs ->
            let splitfs = map splitf fs
                others = catMaybes $ map snd splitfs
                (myfs, a) = j $ catMaybes $ map fst splitfs
                splitf f = case break_on_dir f of
                           Just (d', f') | d' == d -> (Just f', Nothing)
                           _ -> (Nothing, Just f)
            in (others ++ myfs, a)
        mSetFileExecutable _ _ = return ()
        mWriteFilePS _ _ = return ()
        mCreateDirectory _ = return ()
        mRemoveFile f = FPM $ \fs -> (filter (/= f) fs, ())
        mRemoveDirectory f = FPM $ \fs -> (filter (/= f) fs, ())
        mRename a b = FPM $ \fs -> (map (movedirfilename a b) fs, ())
        mModifyFilePS _ _ = return ()
        mModifyFilePSs _ _ = return ()