project-template-0.2.1.0/Text/0000755000000000000000000000000013700304614014237 5ustar0000000000000000project-template-0.2.1.0/test/0000755000000000000000000000000013700304614014272 5ustar0000000000000000project-template-0.2.1.0/test/Text/0000755000000000000000000000000013700304614015216 5ustar0000000000000000project-template-0.2.1.0/Text/ProjectTemplate.hs0000644000000000000000000001537413700305441017706 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} module Text.ProjectTemplate ( -- * Create a template createTemplate -- * Unpack a template , unpackTemplate -- ** Receivers , FileReceiver , receiveMem , receiveFS -- * Exceptions , ProjectTemplateException (..) ) where import Control.Exception (Exception, assert) import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource, MonadThrow, throwM) import Control.Monad.Writer (MonadWriter, tell) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as L import Data.Conduit (ConduitM, await, awaitForever, leftover, yield, runConduit, (.|)) import qualified Data.Conduit.Binary as CB import Data.Conduit.List (consume, sinkNull) import Conduit (concatMapC, chunksOfCE) import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Typeable (Typeable) import Data.Void (Void) import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory, ()) -- | Create a template file from a stream of file/contents combinations. -- -- Since 0.1.0 createTemplate :: Monad m => ConduitM (FilePath, m ByteString) ByteString m () createTemplate = awaitForever $ \(fp, getBS) -> do bs <- lift getBS case runConduit $ yield bs .| CT.decode CT.utf8 .| sinkNull of Nothing -> do yield "{-# START_FILE BASE64 " yield $ encodeUtf8 $ T.pack fp yield " #-}\n" yield (B64.encode bs) .| chunksOfCE 76 .| concatMapC (\x -> [x, "\n"]) yield "\n" Just _ -> do yield "{-# START_FILE " yield $ encodeUtf8 $ T.pack fp yield " #-}\n" yield bs yield "\n" -- | Unpack a template to some destination. Destination is provided by the -- first argument. -- -- The second argument allows you to modify the incoming stream, usually to -- replace variables. For example, to replace PROJECTNAME with myproject, you -- could use: -- -- > Data.Text.replace "PROJECTNAME" "myproject" -- -- Note that this will affect both file contents and file names. -- -- Since 0.1.0 unpackTemplate :: MonadThrow m => (FilePath -> ConduitM ByteString o m ()) -- ^ receive individual files -> (Text -> Text) -- ^ fix each input line, good for variables -> ConduitM ByteString o m () unpackTemplate perFile fixLine = CT.decode CT.utf8 .| CT.lines .| CL.map fixLine .| start where start = await >>= maybe (return ()) go where go t = case getFileName t of Nothing -> lift $ throwM $ InvalidInput t Just (fp', isBinary) -> do let src | isBinary = binaryLoop .| decode64 | otherwise = textLoop True src .| perFile (T.unpack fp') start binaryLoop = do await >>= maybe (return ()) go where go t = case getFileName t of Just{} -> leftover t Nothing -> do yield $ encodeUtf8 t binaryLoop textLoop isFirst = await >>= maybe (return ()) go where go t = case getFileName t of Just{} -> leftover t Nothing -> do unless isFirst $ yield "\n" yield $ encodeUtf8 t textLoop False getFileName t = case T.words t of ["{-#", "START_FILE", fn, "#-}"] -> Just (fn, False) ["{-#", "START_FILE", "BASE64", fn, "#-}"] -> Just (fn, True) _ -> Nothing -- | The first argument to 'unpackTemplate', specifying how to receive a file. -- -- Since 0.1.0 type FileReceiver m = FilePath -> ConduitM ByteString Void m () -- | Receive files to the given folder on the filesystem. -- -- > unpackTemplate (receiveFS "some-destination") (T.replace "PROJECTNAME" "foo") -- -- Since 0.1.0 receiveFS :: MonadResource m => FilePath -- ^ root -> FileReceiver m receiveFS root rel = do liftIO $ createDirectoryIfMissing True $ takeDirectory fp CB.sinkFile fp where fp = root rel -- | Receive files to a @Writer@ monad in memory. -- -- > execWriter $ runExceptionT_ $ src $$ unpackTemplate receiveMem id -- -- Since 0.1.0 receiveMem :: MonadWriter (Map FilePath L.ByteString) m => FileReceiver m receiveMem fp = do bss <- consume lift $ tell $ Map.singleton fp $ L.fromChunks bss -- | Exceptions that can be thrown. -- -- Since 0.1.0 data ProjectTemplateException = InvalidInput Text | BinaryLoopNeedsOneLine deriving (Show, Typeable) instance Exception ProjectTemplateException decode64 :: Monad m => ConduitM ByteString ByteString m () decode64 = codeWith 4 B64.decodeLenient codeWith :: Monad m => Int -> (ByteString -> ByteString) -> ConduitM ByteString ByteString m () codeWith size f = loop where loop = await >>= maybe (return ()) push loopWith bs | S.null bs = loop | otherwise = await >>= maybe (yield (f bs)) (pushWith bs) push bs = do let (x, y) = S.splitAt (len - (len `mod` size)) bs unless (S.null x) $ yield $ f x loopWith y where len = S.length bs pushWith bs1 bs2 | S.length bs1 + S.length bs2 < size = loopWith (S.append bs1 bs2) pushWith bs1 bs2 = assertion1 $ assertion2 $ do yield $ f bs1' push y where m = S.length bs1 `mod` size (x, y) = S.splitAt (size - m) bs2 bs1' = S.append bs1 x assertion1 = assert $ S.length bs1 < size assertion2 = assert $ S.length bs1' `mod` size == 0 project-template-0.2.1.0/test/Spec.hs0000644000000000000000000000005413700304614015517 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} project-template-0.2.1.0/test/Text/ProjectTemplateSpec.hs0000644000000000000000000000405613700305664021502 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Text.ProjectTemplateSpec where import Test.Hspec import Test.Hspec.QuickCheck import Text.ProjectTemplate import Data.Conduit import Control.Monad.Trans.Writer (execWriterT) import Test.QuickCheck.Arbitrary import Data.Char (isAlphaNum) import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import qualified Data.Map as Map import Control.Arrow (second, (***)) import Control.Applicative ((<$>)) import Data.Monoid (mconcat, mappend) spec :: Spec spec = do describe "create/unpack" $ do prop "is idempotent" $ \(Helper m) -> do m' <- execWriterT $ runConduit $ mapM_ (yield . second return) (Map.toList m) .| createTemplate .| unpackTemplate receiveMem id let m'' = Map.fromList $ map (second $ mconcat . L.toChunks) $ Map.toList m' m `shouldBe` m'' describe "binaries" $ do prop "works with multilines" $ \words' -> do let bs = S.pack words' encoded = joinWith "\n" 5 $ B64.encode bs content = "{-# START_FILE BASE64 foo #-}\n" `mappend` encoded m <- execWriterT $ runConduit $ yield content .| unpackTemplate receiveMem id Map.lookup "foo" m `shouldBe` Just (L.fromChunks [bs]) joinWith :: S.ByteString -> Int -> S.ByteString -> S.ByteString joinWith joiner size = S.concat . map (`S.append` joiner) . chunksOf size chunksOf :: Int -> S.ByteString -> [S.ByteString] chunksOf _ bs | S.null bs = [] chunksOf size bs = let (x, y) = S.splitAt size bs in x : chunksOf size y newtype Helper = Helper (Map.Map FilePath S.ByteString) deriving (Show, Eq) instance Arbitrary Helper where arbitrary = Helper . Map.fromList <$> mapM (const $ (def "foo" . filter isAlphaNum *** S.pack . def (S.unpack "bar")) <$> arbitrary) [1..10 :: Int] where def x y | null y = x | otherwise = y project-template-0.2.1.0/LICENSE0000644000000000000000000000277013700304614014326 0ustar0000000000000000Copyright (c) 2012, Michael Snoyman 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 Michael Snoyman nor the names of other 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. project-template-0.2.1.0/Setup.hs0000644000000000000000000000005613700304614014750 0ustar0000000000000000import Distribution.Simple main = defaultMain project-template-0.2.1.0/project-template.cabal0000644000000000000000000000365313700306156017570 0ustar0000000000000000name: project-template version: 0.2.1.0 synopsis: Specify Haskell project templates and generate files description: See initial blog post for explanation: homepage: https://github.com/fpco/haskell-ide license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: michael@fpcomplete.com category: Development build-type: Simple cabal-version: >=1.10 extra-source-files: README.md ChangeLog.md library default-language: Haskell2010 exposed-modules: Text.ProjectTemplate build-depends: base >= 4 && < 5 , base64-bytestring , text >= 0.11 , bytestring >= 0.9 , transformers >= 0.2 , mtl >= 2.0 , conduit >= 1.2.8 && < 1.4 , conduit-extra , resourcet >= 0.4.3 , containers , filepath , directory ghc-options: -Wall test-suite test default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs other-modules: Text.ProjectTemplateSpec type: exitcode-stdio-1.0 build-depends: base , project-template , hspec >= 1.3 , transformers , QuickCheck , base64-bytestring , conduit , text , bytestring , containers , resourcet ghc-options: -Wall source-repository head type: git location: git://github.com/fpco/haskell-ide.git project-template-0.2.1.0/README.md0000644000000000000000000002176613700304614014606 0ustar0000000000000000Copy of the announcment blog post: * * * In my [last blog post](http://www.yesodweb.com/blog/2012/09/building-haskell-ide), I discussed one aspect of my work with FP Complete: the goal of creating a Haskell IDE. Since then, I've gotten lots of incredible feedback from the community, and in particular have been in email discussion with some of the major players in the Haskell IDE scene. I think it's safe to say that we all agree that there's going to be a large amount of overlap in our efforts, and we will be coordinating to try and minimize duplicated work as much as possible, while still providing for the unique goals of each IDE project. In response to all this, I've created a [Wiki on Github](https://github.com/fpco/haskell-ide/wiki) to keep track of our goals, and a [Haskell IDE Google Group](https://groups.google.com/d/forum/haskell-ide) for discussion. I strongly recommend joining if you're interested in any more sophisticated Haskell code editing tools. We have a lot of topics to cover, and a single blog post won't be nearly enough to even scratch the surface. For now, I'd like to focus on one specific feature. I haven't chosen to start here because it's the most important feature, but because I think it's a problem that we can solve relatively easily and thoroughly. ## Project Templates Most (all?) IDEs provide the concept of a project template: instead of writing all of the code for a project from scratch, you select a template, answer a few questions, and a bunch of files are automatically generated. We already have this in the Haskell world: Yesod provides the project scaffolded (via the `yesod init` command), and I believe Snap provides something like this as well. But these are just two examples. I'm sure we could easily come up with a dozen other possible templates: a GTK+ application, a web services client, or a console app. Currently, there's no standard for how this should work in the Haskell world or, to my knowledge, in the non-Haskell world either. (If there is, please let me know, I'd like to be able to build on existing work.) The Yesod scaffolding (and Snap's I believe) are both generated via specialized command line tools. I'm sure each IDE would be fully capable of building wrappers for for two tools, but that quickly becomes an existential complexity issue. It also makes it much more difficult for someone to start providing a new scaffolding. I know we suffer from this already in the Yesod world, where innovation is definitely stifled by having the One True Blessed Scaffolding. So here are my goals for the ideal templating system: * A single file to represent a template. This can be some kind of archive (ZIP file, tarball, etc), I don't really care, but single file systems simplify things greatly. * Provide a Haskell library for both generating and consuming these templates. We can have a command line tool as a wrapper around the library, but the library should be the primary means of interacting. (You'll see this as a pattern as I talk more about the IDE world.) * Build on top of commonly used formats as much as possible. The reasoning here is that, even though we'll be providing a canonical Haskell library, not all IDEs are written in Haskell (yet). If someone is writing an IDE in Python and wants to provide Haskell support, we should make it as easy as possible. * By the way, it's worth pointing out that, as described, there's nothing Haskell-centric about my proposal here. I've been going in the direction of creating language-agnostic tools and formats as much as possible (e.g., [`keter`](http://hackage.haskell.org/package/keter), which can host web apps written in *any* language). * I'm guessing that the most common way that people will want to actually provide a template is as a Git(hub)/Darcs repo. It would be great if we could provide a web service that takes a repo and automatically generates a template file. Then users of an IDE could theoretically just type in a repo URL to some text box and automatically get the most recent code available. * Similarly, we should provide a simple command-line tool that takes a folder and generates a template file. ## A semi-concrete proposal As many of you know, I normally prefer to discuss actual working code/ideas than to discuss theoretical ideas. In this case, however, I think it's worth fleshing out the idea a bit before jumping in and implementing something. So I'm going to lay out my proposal here, and ask for everyone's input and recommendations before we start implementation. I recommend the discussion be targeted at the [Haskell IDE Google Group](https://groups.google.com/d/forum/haskell-ide) as much as possible. For file format: let's use JSON. I'm not worried about file size: these project template files will likely be transferred over HTTP most of the time, and compression can be performed at that level. As for binary files, we'll base64-encode the contents. The JSON file needs to have three sections: 1. Metadata describing the project template itself. This would be the name of the template, a description, author, homepage, and maybe a version. (Version could be automatically generated as the date it was created.) This is all pretty boring. 2. Data that needs to be collected from the user. In the Yesod scaffolding, we ask for the user's name, the project name, and the database backend to use. The first two are (mostly) free-form text, while the third is an enumeration. I think we'll need to support a few basic datatypes: * Text, with a regex for validation. * Booleans * Enumerations We can also allow default values. So to model the Yesod scaffolding, perhaps something like this: ~~~json {"user-fields": [ {"name":"user-name","type":"text","validation":".+","description":"Your name"} , {"name":"project-name","type":"text","validation":"[\w_]+","description":"Name of your project"} , {"name":"database-backend","type":"enumerator","choices": [{"display":"MySQL","value":"mysql"},{"display":"MongoDB","value":"mongodb"}], "description":"Name of your project"} ]} ~~~ 3. The files that will be generated. We need to take into account some issues: 1. Some files will be generated conditionally based on the input from the user. 2. Some of the files will be named based on the user input (e.g., the name of the `cabal` file). 3. The actual contents of the file will depend on the user input (e.g., the *contents* of the `cabal` file). 4. We want to support both textual and binary files. Binary files need not have any conditional aspect to them. For the first issue, we'll need to have a basic expression language. I think equality, inequality, and, or, parantheses and variables should be sufficient. So to say that the file `config/postgres.yml` should only be generated if the database backend is postgresql, we could have something like: ~~~json {"filename":"config/postgres.yml", "contents":"We'll discuss this in a moment...", "condition":"database-backend == 'postgresql'" } ~~~ For the conditional file naming, how about something like this: ~~~json {"filename":[{"variable":"project-name"},{"content":".cabal"}], "contents":"..." } ~~~ In order to solve the third point, we'll use a combination of what we've established for points 1 and 2: ~~~json {"filename":[{"variable":"project-name"},{"content":".cabal"}], "contents": [ {"content":"name: "}, {"variable":"project-name"}, {"content":"...build-depends:..."}, {"content":"\n , postgresql-simple >= 0.3 && < 0.4","condition":"database-backend == 'postgresql'"} ] } ~~~ The last one is easiest to solve: each file can have a field `encoding` which is either "text" or "base64". ~~~json {"filename":"some-image.png", "contents":"DEADBEEF", "encoding":"base64" } ~~~ Once we have the file format figured out, the library is relatively simple. Let's describe a simple consumption API: ~~~haskell data CodeTemplate instance FromJSON CodeTemplate data UserInputType = UIText (Maybe Regex) | UIEnumeration [(Text, Text)] | UIBool data UserInput = UserInput { uiType :: UserInputType , uiName :: Text , uiDescription :: Text } userInputs :: CodeTemplate -> [UserInput] generateFiles :: CodeTemplate -> Map Text Text -> Map FilePath LByteString ~~~ Setting up a generation API for dealing with completely static files should be simple. It will be a bit more involved to deal with conditionals, but with properly defined ADTs it shouldn't be too bad. ## Next steps I think the most important next step is to determine what use cases my proposal doesn't cover. The file creating code specifically doesn't allow many common text generation techniques, like looping, as I simply see no use case for it, but perhaps I'm mistaken. I'm also curious to hear what other ideas people have for project templates. project-template-0.2.1.0/ChangeLog.md0000644000000000000000000000036713700305773015501 0ustar0000000000000000# ChangeLog for project-template ## 0.2.1.0 * Support base64-bytestring 1.1.0.0 [#4](https://github.com/fpco/haskell-ide/issues/4) ## 0.2.0.1 * Use `throwM` instead of `monadThrow` * Support for conduit 1.3.0 ## 0.2.0 * Drop system-filepath