project-template (empty) → 0.1.0.0
raw patch · 6 files changed
+250/−0 lines, 6 filesdep +QuickCheckdep +basedep +base64-bytestringsetup-changed
Dependencies added: QuickCheck, base, base64-bytestring, bytestring, classy-prelude-conduit, hspec, mtl, project-template, resourcet, system-fileio, system-filepath, text, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Text/ProjectTemplate.hs +139/−0
- project-template.cabal +43/−0
- test/Spec.hs +1/−0
- test/Text/ProjectTemplateSpec.hs +35/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/ProjectTemplate.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Text.ProjectTemplate+ ( -- * Create a template+ createTemplate+ -- * Unpack a template+ , unpackTemplate+ -- ** Receivers+ , FileReceiver+ , receiveMem+ , receiveFS+ -- * Exceptions+ , ProjectTemplateException (..)+ ) where++import ClassyPrelude.Conduit+import Control.Monad.Writer (MonadWriter, tell)+import qualified Data.ByteString.Base64 as B64+import Data.Functor.Identity (runIdentity)+import Data.Typeable (Typeable)+import Filesystem (createTree)+import Filesystem.Path.CurrentOS (directory, encode, fromText)++-- | Create a template file from a stream of file/contents combinations.+--+-- Since 0.1.0+createTemplate+ :: Monad m+ => GInfConduit (FilePath, m ByteString) m ByteString+createTemplate = awaitForever $ \(fp, getBS) -> do+ bs <- lift getBS+ case runIdentity $ runExceptionT $ yield bs $$ decodeUtf8 =$ sinkNull of+ Left{} -> do+ yield "{-# START_FILE BASE64 "+ yield $ encode fp+ yield " #-}\n"+ yield $ B64.encode bs+ yield "\n"+ Right{} -> do+ yield "{-# START_FILE "+ yield $ encode 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 -> Sink ByteString m ()) -- ^ receive individual files+ -> (Text -> Text) -- ^ fix each input line, good for variables+ -> Sink ByteString m ()+unpackTemplate perFile fixLine =+ decodeUtf8 =$ lines =$ map fixLine =$ start+ where+ start =+ await >>= maybe (return ()) go+ where+ go t =+ case getFileName t of+ Nothing -> lift $ monadThrow $ InvalidInput t+ Just (fp', isBinary) -> do+ let src+ | isBinary = binaryLoop+ | otherwise = textLoop True+ src =$ perFile (fromText fp')+ start++ binaryLoop = do+ await >>= maybe (lift $ monadThrow BinaryLoopNeedsOneLine) go+ where+ go = yield . B64.decodeLenient . encodeUtf8+ 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 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 -> Sink ByteString 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 $ createTree $ directory fp+ writeFile 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 LByteString) m+ => FileReceiver m+receiveMem fp = do+ bss <- consume+ lift $ tell $ singleton fp $ fromChunks bss++-- | Exceptions that can be thrown.+--+-- Since 0.1.0+data ProjectTemplateException = InvalidInput Text+ | BinaryLoopNeedsOneLine+ deriving (Show, Typeable)+instance Exception ProjectTemplateException
+ project-template.cabal view
@@ -0,0 +1,43 @@+name: project-template+version: 0.1.0.0+synopsis: Specify Haskell project templates and generate files+description: See initial blog post for explanation: <http://www.yesodweb.com/blog/2012/09/project-templates>+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.8++library+ exposed-modules: Text.ProjectTemplate+ build-depends: base >= 4 && < 5+ , classy-prelude-conduit >= 0.4+ , base64-bytestring+ , system-filepath >= 0.4+ , system-fileio >= 0.3+ , text >= 0.11+ , bytestring >= 0.9+ , transformers >= 0.2+ , mtl >= 2.0+ , resourcet >= 0.4.1+ ghc-options: -Wall++test-suite test+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Text.ProjectTemplateSpec+ type: exitcode-stdio-1.0+ build-depends: base+ , project-template+ , classy-prelude-conduit+ , hspec >= 1.3+ , transformers+ , QuickCheck+ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/fpco/haskell-ide.git
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Text/ProjectTemplateSpec.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Text.ProjectTemplateSpec where++import Test.Hspec+import Test.Hspec.QuickCheck+import Text.ProjectTemplate+import ClassyPrelude.Conduit+import Control.Monad.Trans.Writer (execWriter)+import Test.QuickCheck.Arbitrary+import Data.Char (isAlphaNum)++spec :: Spec+spec = do+ describe "create/unpack" $ do+ prop "is idempotent" $ \(Helper m) ->+ let m' =+ execWriter+ $ runExceptionT_+ $ mapM_ (yield . second return) (unpack m)+ $$ createTemplate+ =$ unpackTemplate receiveMem id+ m'' = pack $ map (second $ concat . toChunks) $ unpack m'+ in if m == m'' then True else error (show m'')++newtype Helper = Helper (Map FilePath ByteString)+ deriving (Show, Eq)++instance Arbitrary Helper where+ arbitrary =+ Helper . pack <$> mapM (const $ (pack . def "foo" . filter isAlphaNum *** pack . def (unpack $ asByteString "bar")) <$> arbitrary) [1..10 :: Int]+ where+ def x y+ | null y = x+ | otherwise = y