Artifact.hs

module Ivory.Artifact (
  -- * Ivory Artifacts
  -- | Artifacts permit the user to generate non-Ivory language files
  -- as part of an Ivory program's build process. Artifacts are typically
  -- used to encapsulate helper code (such as Ivory.Stdlib's string functions
  -- helper .c and .h files) or to generate debug or metadata output. The
  -- contents of an `Artifact` are given by some external file, or as a string.
  --
  -- Artifacts are exposed as an abstract type `Artifact` with a set of
  -- constructors, an accessor `artifactFileName`, and two functions,
  -- `putArtifact` and `printArtifact`, which are used to write an
  -- Artifacts to a file or print it to stdout, respectively.
  --
  -- Users may specify transformations on the contents of an artifact.
  -- Optionally, these transformations can throw an error. This is useful when
  -- using artifact files as templates.
  --
    Artifact()
  -- | Gives the file name that will be used when writing the `Artifact` to the
  -- filesystem.
  , artifactFileName

  -- * Artifact constructors
  -- | `artifactFile` creates an `Artifact` from an output filename of type
  -- `FilePath` and an input filepath of type `IO FilePath`. The output filename
  -- should be a simple filename, any directory information will be dropped. The
  -- input filepath should be an absolute path. The input filepath is in the IO
  -- monad for compatiblility with Cabal's `getDataDir` data files functionality.
  , artifactFile

  -- | `artifactCabalFile` creates an `Artifact` given an input directory of
  -- type `IO FilePath` and an input filepath, relative to the input directory
  -- in the preceeding argument, of type `FilePath`.
  --
  -- This function is designed to be used with a Cabal Paths_(packagename)
  -- `getDataDir`, which has type `IO FilePath`, and a path to a file inside the
  -- data directory.  It is implemented in terms of `artifactFileName`. The
  -- output filename is given by dropping directory information from the input
  -- filepath.
  , artifactCabalFile

  -- | `artifactText` creates an `Artifact` from an output filename of type
  -- `FilePath` and with contents of type `Text`.
  , artifactText
  -- | `artifactString` creates an `Artifact` from an output filename of type
  -- `FilePath` with contents of type `String`. Implemented in terms of
  -- `artifactText`.
  , artifactString

  -- | `artifactTransform` and `artifactTransformString` specify a
  -- transformation on the contents of an `Artifact`.
  , artifactTransform, artifactTransformString

  -- | `artifactTransformErr` and `artifactTransformErrString` specify a
  -- transformation on the contents of an `Artifact` which may give an error.
  , artifactTransformErr, artifactTransformErrString

  -- | `artifactPath` prepends a `FilePath` to the output file path.
  , artifactPath

  -- * Artifact actions
  -- | Takes a directory of type `FilePath` and an `Artifact`
  -- writes each `Artifact` to the file system or gives an error explaining why
  -- not. `Maybe String` containins errors encountered when an `Artifact` is
  -- transformed, or specified by an input filename which does not exist.
  , putArtifact
  -- | like `putArtifact` but ignores any errors.
  , putArtifact_

  -- | Takes an `Artifact` and prints it, or an appropriate error message, to
  -- stdout.
  , printArtifact

  -- | Takes a guess at whether two artifacts might be equal.
  , mightBeEqArtifact

  , Located(..)
  , mightBeEqLocatedArtifact
  ) where

import Control.Monad (void)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
import System.FilePath
import System.Directory
import Ivory.Artifact.Transformer
import Ivory.Artifact.Location
import System.IO.Unsafe (unsafePerformIO)

data Artifact =
  Artifact
    { artifact_outputname  :: FilePath
    , artifact_contents    :: AContents
    , artifact_transformer :: Transformer T.Text
    }

mightBeEqLocatedArtifact :: Located Artifact -> Located Artifact -> Bool
mightBeEqLocatedArtifact (Root a) (Root b) = mightBeEqArtifact a b
mightBeEqLocatedArtifact (Src a) (Src b) = mightBeEqArtifact a b
mightBeEqLocatedArtifact (Incl a) (Incl b) = mightBeEqArtifact a b
mightBeEqLocatedArtifact _ _ = False

mightBeEqArtifact :: Artifact -> Artifact -> Bool
mightBeEqArtifact a b =
  and [ artifact_outputname a == artifact_outputname b
      , artifact_contents   a `mightBeEqAContents` artifact_contents   b]

data AContents = LiteralContents T.Text
               | FileContents (IO FilePath)

mightBeEqAContents :: AContents -> AContents -> Bool
mightBeEqAContents (LiteralContents a) (LiteralContents b) = a == b
mightBeEqAContents (FileContents a) (FileContents b) = unsafePerformIO a == unsafePerformIO b
mightBeEqAContents _ _ = False

artifactFileName :: Artifact -> FilePath
artifactFileName = artifact_outputname

artifactFile :: FilePath -> IO FilePath -> Artifact
artifactFile outputname inputpath = Artifact
  { artifact_outputname  = takeFileName outputname
  , artifact_contents    = FileContents inputpath
  , artifact_transformer = emptyTransformer
  }

artifactCabalFile :: IO FilePath -> FilePath -> Artifact
artifactCabalFile inputdir inputfname =
  artifactFile (takeFileName inputfname)
               (fmap (\i -> (i </> inputfname)) inputdir)

artifactText :: FilePath -> T.Text -> Artifact
artifactText outputname t = Artifact
  { artifact_outputname  = takeFileName outputname
  , artifact_contents    = LiteralContents t
  , artifact_transformer = emptyTransformer
  }

artifactPath :: FilePath -> Artifact -> Artifact
artifactPath f a = a { artifact_outputname = f </> artifact_outputname a }

artifactString :: FilePath -> String -> Artifact
artifactString f s = artifactText f (T.pack s)

artifactTransform :: (T.Text -> T.Text) -> Artifact -> Artifact
artifactTransform f a =
  a { artifact_transformer = transform f (artifact_transformer a) }

artifactTransformString :: (String -> String) -> Artifact -> Artifact
artifactTransformString f a = artifactTransform f' a
  where f' = T.pack . f . T.unpack

artifactTransformErr :: (T.Text -> Either String T.Text) -> Artifact -> Artifact
artifactTransformErr f a =
  a { artifact_transformer = transformErr f (artifact_transformer a) }

artifactTransformErrString :: (String -> Either String String) -> Artifact -> Artifact
artifactTransformErrString f a = artifactTransformErr f' a
  where f' t = fmap T.pack (f (T.unpack t))

getArtifact :: Artifact -> IO (Either String T.Text)
getArtifact a = g (artifact_contents a)
  where
  runT t = runTransformer (artifact_transformer a) t
  g (LiteralContents t) = return (runT t)
  g (FileContents getf) = do
      srcpath <- getf
      -- Check if srcpath exists. If it does not, give an error
      exists <- doesFileExist srcpath
      case exists of
        True -> do
          t <- T.readFile srcpath
          return (runT t)
        False -> return (Left (notfound srcpath))

  notfound srcpath = "Path " ++ srcpath ++ " for Artifact named "
     ++ artifact_outputname a ++ " could not be found."

withContents :: Artifact -> (T.Text -> IO ()) -> IO (Maybe String)
withContents a f = do
  contents <- getArtifact a
  case contents of
    Left err -> return (Just err)
    Right c  -> f c >> return Nothing

putArtifact :: FilePath -> Artifact -> IO (Maybe String)
putArtifact fp a = withContents a $ \c -> do
  let fname = fp </> artifact_outputname a
  createDirectoryIfMissing True (dropFileName fname)
  T.writeFile fname c

putArtifact_ :: FilePath -> Artifact -> IO ()
putArtifact_ fp a = void (putArtifact fp a)

printArtifact :: Artifact -> IO ()
printArtifact a = do
  res <- withContents a aux
  case res of
    Nothing -> return ()
    Just err -> putStrLn $
      "Encountered error when creating artifact " ++ artifact_outputname a
        ++ ":\n" ++ err
  where
  aux c = do
    putStrLn ("Artifact " ++ artifact_outputname a)
    putStrLn "================"
    T.putStrLn c
    putStrLn "================"