1 files changed, 78 insertions, 7 deletions

diff --git a/src/Language/PureScript/Make/Monad.hs b/src/Language/PureScript/Make/Monad.hs
index bbc737e..6fe38f3 100644
--- a/src/Language/PureScript/Make/Monad.hs
+++ b/src/Language/PureScript/Make/Monad.hs
@@ -5,11 +5,19 @@ module Language.PureScript.Make.Monad
     Make(..)
   , runMake
   , makeIO
+  , getTimestamp
+  , getTimestampMaybe
   , readTextFile
+  , readTextFileMaybe
+  , readJSONFile
+  , writeTextFile
+  , writeJSONFile
   ) where
 
 import           Prelude
 
+import           Control.Exception (tryJust)
+import           Control.Monad (join, guard)
 import           Control.Monad.Base (MonadBase(..))
 import           Control.Monad.Error.Class (MonadError(..))
 import           Control.Monad.IO.Class
@@ -18,11 +26,17 @@ import           Control.Monad.Reader (MonadReader(..), ReaderT(..))
 import           Control.Monad.Trans.Control (MonadBaseControl(..))
 import           Control.Monad.Trans.Except
 import           Control.Monad.Writer.Class (MonadWriter(..))
+import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy as B
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Data.Time.Clock (UTCTime)
 import           Language.PureScript.AST
 import           Language.PureScript.Errors
 import           Language.PureScript.Options
-import           System.IO.Error (tryIOError)
+import           System.Directory (createDirectoryIfMissing, getModificationTime)
+import           System.FilePath (takeDirectory)
+import           System.IO.Error (tryIOError, isDoesNotExistError)
 
 -- | A monad for running make actions
 newtype Make a = Make
@@ -41,14 +55,71 @@ instance MonadBaseControl IO Make where
 runMake :: Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
 runMake opts = runLogger' . runExceptT . flip runReaderT opts . unMake
 
--- | Run an 'IO' action in the 'Make' monad, by specifying how IO errors should
--- be rendered as 'ErrorMessage' values.
-makeIO :: (IOError -> ErrorMessage) -> IO a -> Make a
-makeIO f io = do
+-- | Run an 'IO' action in the 'Make' monad. The 'String' argument should
+-- describe what we were trying to do; it is used for rendering errors in the
+-- case that an IOException is thrown.
+makeIO :: Text -> IO a -> Make a
+makeIO description io = do
   e <- liftIO $ tryIOError io
-  either (throwError . singleError . f) return e
+  either (throwError . singleError . ErrorMessage [] . FileIOError description) return e
+
+-- | Get a file's modification time in the 'Make' monad, capturing any errors
+-- using the 'MonadError' instance.
+getTimestamp :: FilePath -> Make UTCTime
+getTimestamp path =
+  makeIO ("get a timestamp for file: " <> Text.pack path) $ getModificationTime path
+
+-- | Get a file's modification time in the 'Make' monad, returning Nothing if
+-- the file does not exist.
+getTimestampMaybe :: FilePath -> Make (Maybe UTCTime)
+getTimestampMaybe path =
+  makeIO ("get a timestamp for file: " <> Text.pack path) $ catchDoesNotExist $ getModificationTime path
 
 -- | Read a text file in the 'Make' monad, capturing any errors using the
 -- 'MonadError' instance.
 readTextFile :: FilePath -> Make B.ByteString
-readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ B.readFile path
+readTextFile path =
+  makeIO ("read file: " <> Text.pack path) $ B.readFile path
+
+-- | Read a text file in the 'Make' monad, or return 'Nothing' if the file does
+-- not exist. Errors are captured using the 'MonadError' instance.
+readTextFileMaybe :: FilePath -> Make (Maybe B.ByteString)
+readTextFileMaybe path =
+  makeIO ("read file: " <> Text.pack path) $ catchDoesNotExist $ B.readFile path
+
+-- | Read a JSON file in the 'Make' monad, returning 'Nothing' if the file does
+-- not exist or could not be parsed. Errors are captured using the 'MonadError'
+-- instance.
+readJSONFile :: Aeson.FromJSON a => FilePath -> Make (Maybe a)
+readJSONFile path =
+  makeIO ("read JSON file: " <> Text.pack path) $ do
+    r <- catchDoesNotExist $ Aeson.decodeFileStrict' path
+    return $ join r
+
+-- | If the provided action threw an 'isDoesNotExist' error, catch it and
+-- return Nothing. Otherwise return Just the result of the inner action.
+catchDoesNotExist :: IO a -> IO (Maybe a)
+catchDoesNotExist inner = do
+  r <- tryJust (guard . isDoesNotExistError) inner
+  case r of
+    Left () ->
+      return Nothing
+    Right x ->
+      return (Just x)
+
+-- | Write a text file in the 'Make' monad, capturing any errors using the
+-- 'MonadError' instance.
+writeTextFile :: FilePath -> B.ByteString -> Make ()
+writeTextFile path text = makeIO ("write file: " <> Text.pack path) $ do
+  createParentDirectory path
+  B.writeFile path text
+
+-- | Write a JSON file in the 'Make' monad, capturing any errors using the
+-- 'MonadError' instance.
+writeJSONFile :: Aeson.ToJSON a => FilePath -> a -> Make ()
+writeJSONFile path value = makeIO ("write JSON file: " <> Text.pack path) $ do
+  createParentDirectory path
+  Aeson.encodeFile path value
+
+createParentDirectory :: FilePath -> IO ()
+createParentDirectory = createDirectoryIfMissing True . takeDirectory