{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

{-# LANGUAGE UndecidableInstances  #-}

module Uniform.Shake ( 
          module Uniform.Shake
        , module Uniform.Shake.Path
        , takeBaseName, splitPath 
        , Action
        , module UniformBase
        , Rules
        , shakeArgs, shake, ShakeOptions(..), shakeOptions
        , Verbosity(..), Lint(..)
        , need, (%>),  (|%>) 
        , want, phony
        )      where

import Development.Shake hiding (Error )
        -- (Action, FilePattern, getDirectoryFiles, copyFileChanged)
import Development.Shake.FilePath (takeBaseName, splitPath
                        )
     
import UniformBase
import Control.Exception (throw)  -- to deal with errors in action
import Uniform.Shake.Path

($-<.>) :: Path a File -> Text ->  Path a File
Path a File
f $-<.> :: forall a. Path a File -> Text -> Path a File
$-<.> Text
e = forall a. Text -> Path a File -> Path a File
replaceExtension' Text
e Path a File
f 

($--<.>) :: Path a File -> Text ->  Path a File
Path a File
f $--<.> :: forall a. Path a File -> Text -> Path a File
$--<.> Text
e = forall a. Text -> Path a File -> Path a File
replaceExtension2 Text
e Path a File
f 

replaceExtension' :: Text -> Path a File -> Path a File
-- a flipped version of -<.> 
replaceExtension' :: forall a. Text -> Path a File -> Path a File
replaceExtension' Text
newext  =
    forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (FilePath -> Extension
makeExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s forall a b. (a -> b) -> a -> b
$ Text
newext) 
replaceExtension2 :: Text -> Path a File -> Path a File
-- remove a doubled extension (e.g. gutenberg.txt)
replaceExtension2 :: forall a. Text -> Path a File -> Path a File
replaceExtension2 Text
newext  =
    forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (FilePath -> Extension
makeExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s forall a b. (a -> b) -> a -> b
$ Text
newext) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Extensions fp => fp -> fp
removeExtension

    -- if isRelative filen 
    --     then makeRelFile resn 
    --     else makeAbsFile resn
    --     where 
    --             filen = toFilePath filep 
    --             resn = replaceExtension (t2s newext) filen 

getDirectoryFilesP :: Path Abs Dir -> [FilePattern] -> Action [Path Rel File]
getDirectoryFilesP :: Path Abs Dir -> [FilePath] -> Action [Path Rel File]
getDirectoryFilesP Path Abs Dir
d [FilePath]
p = do
    [FilePath]
res :: [FilePath] <- FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
d) [FilePath]
p
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Rel File
makeRelFile [FilePath]
res

copyFileChangedP :: Path Abs File -> Path Abs File -> Action ()
copyFileChangedP :: Path Abs File -> Path Abs File -> Action ()
copyFileChangedP Path Abs File
infile Path Abs File
outf = Partial => FilePath -> FilePath -> Action ()
copyFileChanged (forall b t. Path b t -> FilePath
toFilePath Path Abs File
infile) (forall b t. Path b t -> FilePath
toFilePath Path Abs File
outf)

class Path2nd  a c where
    stripProperPrefixP :: Path a b -> Path a c -> Path Rel c
    makeRelativeP  :: Path a Dir -> Path a c -> Path Rel c
    makeRelativeP = forall a c b. Path2nd a c => Path a b -> Path a c -> Path Rel c
stripProperPrefixP
    -- ^ strip the first (the prefix) from the second and returns remainder 
    -- throws error when not prefix or not proper file path 
    replaceDirectoryP :: Path a Dir -> Path a Dir -> Path a c  -> Path a c
    -- ^ strip the first (the prefix) and add the second to the third 
    
instance   Path2nd  a File where
    stripProperPrefixP :: forall b. Path a b -> Path a File -> Path Rel File
stripProperPrefixP Path a b
a Path a File
b = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote
        ( Text -> FilePath
t2s
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords'
        forall a b. (a -> b) -> a -> b
$ [Text
"Path2nd Dir - not a prefix", FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$  Path a b
a, Text
"for",  FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path a File
b]
        )
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Path Rel File
makeRelFile Maybe FilePath
ab)
        where ab :: Maybe FilePath
ab = forall a. CharChains a => a -> a -> Maybe a
stripPrefix' (forall b t. Path b t -> FilePath
toFilePath Path a b
a) (forall b t. Path b t -> FilePath
toFilePath Path a File
b) :: Maybe FilePath

    replaceDirectoryP :: Path a Dir -> Path a Dir -> Path a File -> Path a File
replaceDirectoryP Path a Dir
pref Path a Dir
newpref Path a File
old = Path a Dir
newpref forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
rem1 
        where rem1 :: Path Rel File
rem1 = forall a c b. Path2nd a c => Path a b -> Path a c -> Path Rel c
stripProperPrefixP Path a Dir
pref Path a File
old


instance Path2nd  a Dir where
    stripProperPrefixP :: forall b. Path a b -> Path a Dir -> Path Rel Dir
stripProperPrefixP Path a b
a Path a Dir
b = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote
        ( Text -> FilePath
t2s
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords'
        forall a b. (a -> b) -> a -> b
$ [Text
"Path2nd Dir - not a prefix",  FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path a b
a, Text
"for",  FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path a Dir
b]
        )
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Path Rel Dir
makeRelDir Maybe FilePath
ab)
        where ab :: Maybe FilePath
ab = forall a. CharChains a => a -> a -> Maybe a
stripPrefix' (forall b t. Path b t -> FilePath
toFilePath Path a b
a) (forall b t. Path b t -> FilePath
toFilePath Path a Dir
b) :: Maybe FilePath

    replaceDirectoryP :: Path a Dir -> Path a Dir -> Path a Dir -> Path a Dir
replaceDirectoryP Path a Dir
pref Path a Dir
newpref Path a Dir
old = Path a Dir
newpref forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel Dir
rem1 
        where rem1 :: Path Rel Dir
rem1 = forall a c b. Path2nd a c => Path a b -> Path a c -> Path Rel c
stripProperPrefixP Path a Dir
pref Path a Dir
old

runErr2action :: ErrIO a -> Action a
runErr2action :: forall a. ErrIO a -> Action a
runErr2action ErrIO a
op = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ErrOrVal a
res <- forall a. ErrIO a -> IO (ErrOrVal a)
runErr  ErrIO a
op
    case ErrOrVal a
res of
        Left Text
msg -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords' forall a b. (a -> b) -> a -> b
$ [Text
"runErr2action", Text
msg]
        Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- throwAction :: Text -> Action () 
-- throwAction msg = liftIO . throwIO $ msg

getFilesToBake :: Text -> Path Abs Dir -> [FilePattern] 
        -> Action [Path Rel File]
-- | get all files according to the FilePattern (see Shake docs)
-- in the given directory
-- but excludes all filepath which contain one of the strings in 
-- the first argument to allow directories which are not baked

getFilesToBake :: Text -> Path Abs Dir -> [FilePath] -> Action [Path Rel File]
getFilesToBake Text
exclude Path Abs Dir
d [FilePath]
p = do
    [Path Rel File]
res :: [Path Rel File] <- Path Abs Dir -> [FilePath] -> Action [Path Rel File]
getDirectoryFilesP Path Abs Dir
d [FilePath]
p
    let filtered :: [Path Rel File]
filtered = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. CharChains a => a -> a -> Bool
isInfixOf' Text
exclude) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall b t. Path b t -> FilePath
toFilePath ) [Path Rel File]
res
    -- putIOwords [unlines' $ map (s2t . toFilePath) filtered]
    forall (m :: * -> *) a. Monad m => a -> m a
return   [Path Rel File]
filtered