ivory-artifact (empty) → 0.1.0.3

raw patch · 7 files changed

+362/−0 lines, 7 filesdep +HStringTemplatedep +basedep +directorysetup-changed

Dependencies added: HStringTemplate, base, directory, filepath, text, utf8-string

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• ivory-artifact.cabal +32/−0
• src/Ivory/Artifact.hs +208/−0
• src/Ivory/Artifact/Location.hs +17/−0
• src/Ivory/Artifact/Template.hs +44/−0
• src/Ivory/Artifact/Transformer.hs +29/−0

@@ -0,0 +1,30 @@+Copyright (c)2014, Galois, Inc++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Galois, Inc nor the names of its contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,32 @@+name:                ivory-artifact+synopsis:            Manage additional data files during Ivory compilation.+description:         Mostly used by other Ivory libraries and backends and typically shouldn't have to be used directly by the user.+version:             0.1.0.3+author:              Galois, Inc.+maintainer:          leepike@galois.com+category:            Language+homepage:            http://ivorylang.org+build-type:          Simple+cabal-version:       >= 1.10+license:             BSD3+license-file:        LICENSE+source-repository    this+  type:     git+  location: https://github.com/GaloisInc/ivory+  tag:      hackage-0103++library+  exposed-modules:      Ivory.Artifact,+                        Ivory.Artifact.Template,+                        Ivory.Artifact.Location,+                        Ivory.Artifact.Transformer+  build-depends:        base >= 4.6 && < 5,+                        filepath,+                        directory,+                        text,+                        utf8-string,+                        HStringTemplate+  hs-source-dirs:       src+  default-language:     Haskell2010++  ghc-options:          -Wall

@@ -0,0 +1,208 @@+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 "================"+

@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveFunctor #-}++module Ivory.Artifact.Location+  ( Located(..)+  ) where++-- | In the build, we generally want to put artifacts in one+-- of three locations: somewhere relative to the root directory+-- of the build output, somewhere relative to the sources, or somewhere+-- relative to the includes (headers).++data Located a+  = Root a+  | Src a+  | Incl a+  deriving (Show, Eq, Functor)+

@@ -0,0 +1,44 @@++module Ivory.Artifact.Template+  ( artifactCabalFileTemplate+  , artifactCabalFileTemplate'+  ) where++import Ivory.Artifact+import Text.StringTemplate+import System.FilePath++artifactCabalFileTemplate :: IO FilePath -> FilePath -> [(String, String)]+                          -> Artifact+artifactCabalFileTemplate datadir templatepath attrs =+  artifactCabalFileTemplate' datadir templatepath outputpath attrs+  where+  templatename = takeFileName templatepath+  outputpath = case splitExtension templatename of+    (a, ext) | ext == ".template" -> a+    _ -> templatename++artifactCabalFileTemplate' :: IO FilePath -> FilePath -> FilePath -> [(String, String)]+                          -> Artifact+artifactCabalFileTemplate' datadir templatepath outputpath attrs =+  artifactTransformErrString applyconf af+  where+  af = artifactFile outputpath (fmap (\f -> f </> templatepath) datadir)+  templatename = takeFileName templatepath++  applyconf s =+    let t  = newSTMP s :: StringTemplate String+        t' = setManyAttrib attrs t+    in case checkTemplate t' of+      (Just e, _, _) -> Left (parseErr e)+      (_, Just e, _) -> Left (missingAttrErr e)+      (_, _, Just e) -> Left (missingTemplate e)+      (_, _, _) -> Right (toString t')+  prefix = "Error in " ++ templatename ++ ": "+  parseErr e = prefix ++ "Failed to parse: \n" ++ e+  missingAttrErr es =  prefix ++ "The following attributes are missing:\n"+                    ++ unlines es+  missingTemplate es =  prefix ++ "Failed to lookup invoked templates: \n"+                     ++ unlines es++

@@ -0,0 +1,29 @@++module Ivory.Artifact.Transformer+  ( Transformer()+  , emptyTransformer+  , transform+  , transformErr+  , runTransformer+  ) where++newtype Transformer a =+  Transformer+    { unTransformer :: a -> Either String a+    }++emptyTransformer :: Transformer a+emptyTransformer  = Transformer Right++transform :: (a -> a) -> Transformer a -> Transformer a+transform f (Transformer t) = Transformer $ \a -> do+  a' <- t a+  return (f a')++transformErr :: (a -> Either String a) -> Transformer a -> Transformer a+transformErr f (Transformer t) = Transformer $ \a -> do+  a' <- t a+  f a'++runTransformer :: Transformer a -> a -> Either String a+runTransformer  = unTransformer