module Ivory.Artifact (
Artifact()
, artifactFileName
, artifactFile
, artifactCabalFile
, artifactText
, artifactString
, artifactTransform, artifactTransformString
, artifactTransformErr, artifactTransformErrString
, artifactPath
, putArtifact
, putArtifact_
, printArtifact
, 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
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 "================"