{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings
    , RecordWildCards
    , AllowAmbiguousTypes     #-}

{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

module Uniform.Shake.Path
    where

import           Development.Shake
import UniformBase
import Uniform.Json 
 


getHashedShakeVersionP :: [Path r File] -> IO String
getHashedShakeVersionP :: forall r. [Path r File] -> IO String
getHashedShakeVersionP = [String] -> IO String
getHashedShakeVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> String
toFilePath
                                                
needP :: [Path r File] -> Action ()
needP :: forall r. [Path r File] -> Action ()
needP = Partial => [String] -> Action ()
need forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> String
toFilePath

wantP :: [Path r File] -> Rules ()
wantP :: forall r. [Path r File] -> Rules ()
wantP = Partial => [String] -> Rules ()
want forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> String
toFilePath

($%>) :: Path r File -> Action () -> Rules ()
Path r File
p $%> :: forall r. Path r File -> Action () -> Rules ()
$%> Action ()
a = forall b t. Path b t -> String
toFilePath Path r File
p Partial => String -> (String -> Action ()) -> Rules ()
%> forall a b. a -> b -> a
const Action ()
a


($&%>) :: [Path r File] -> Action () -> Rules ()
[Path r File]
ps $&%> :: forall r. [Path r File] -> Action () -> Rules ()
$&%> Action ()
a = forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> String
toFilePath [Path r File]
ps Partial => [String] -> ([String] -> Action ()) -> Rules ()
&%> forall a b. a -> b -> a
const Action ()
a


orderOnlyP :: [Path r File] -> Action ()
orderOnlyP :: forall r. [Path r File] -> Action ()
orderOnlyP = [String] -> Action ()
orderOnly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> String
toFilePath