diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.2.0.1 + +* Use `throwM` instead of `monadThrow` +* Support for conduit 1.3.0 + ## 0.2.0 * Drop system-filepath diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -84,7 +84,7 @@ 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 -targetted at the [Haskell IDE Google +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 diff --git a/Text/ProjectTemplate.hs b/Text/ProjectTemplate.hs --- a/Text/ProjectTemplate.hs +++ b/Text/ProjectTemplate.hs @@ -22,15 +22,15 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource, MonadThrow, - 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 (Conduit, Sink, await, +import Data.Conduit (ConduitM, await, awaitForever, leftover, yield, - ($$), (=$), (=$=)) + runConduit, (.|)) import qualified Data.Conduit.Binary as CB import Data.Conduit.List (consume, sinkNull) import qualified Data.Conduit.List as CL @@ -41,6 +41,7 @@ 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, ()) @@ -48,10 +49,10 @@ -- -- Since 0.1.0 createTemplate - :: Monad m => Conduit (FilePath, m ByteString) m ByteString + :: Monad m => ConduitM (FilePath, m ByteString) ByteString m () createTemplate = awaitForever $ \(fp, getBS) -> do bs <- lift getBS - case yield bs $$ CT.decode CT.utf8 =$ sinkNull of + case runConduit $ yield bs .| CT.decode CT.utf8 .| sinkNull of Nothing -> do yield "{-# START_FILE BASE64 " yield $ encodeUtf8 $ T.pack fp @@ -79,23 +80,23 @@ -- Since 0.1.0 unpackTemplate :: MonadThrow m - => (FilePath -> Sink ByteString m ()) -- ^ receive individual files + => (FilePath -> ConduitM ByteString o m ()) -- ^ receive individual files -> (Text -> Text) -- ^ fix each input line, good for variables - -> Sink ByteString m () + -> ConduitM ByteString o m () unpackTemplate perFile fixLine = - CT.decode CT.utf8 =$ CT.lines =$ CL.map fixLine =$ start + 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 $ monadThrow $ InvalidInput t + Nothing -> lift $ throwM $ InvalidInput t Just (fp', isBinary) -> do let src - | isBinary = binaryLoop =$= decode64 + | isBinary = binaryLoop .| decode64 | otherwise = textLoop True - src =$ perFile (T.unpack fp') + src .| perFile (T.unpack fp') start binaryLoop = do @@ -127,7 +128,7 @@ -- | The first argument to 'unpackTemplate', specifying how to receive a file. -- -- Since 0.1.0 -type FileReceiver m = FilePath -> Sink ByteString m () +type FileReceiver m = FilePath -> ConduitM ByteString Void m () -- | Receive files to the given folder on the filesystem. -- @@ -162,10 +163,10 @@ deriving (Show, Typeable) instance Exception ProjectTemplateException -decode64 :: Monad m => Conduit ByteString m ByteString +decode64 :: Monad m => ConduitM ByteString ByteString m () decode64 = codeWith 4 B64.decodeLenient -codeWith :: Monad m => Int -> (ByteString -> ByteString) -> Conduit ByteString m ByteString +codeWith :: Monad m => Int -> (ByteString -> ByteString) -> ConduitM ByteString ByteString m () codeWith size f = loop where diff --git a/project-template.cabal b/project-template.cabal --- a/project-template.cabal +++ b/project-template.cabal @@ -1,5 +1,5 @@ name: project-template -version: 0.2.0 +version: 0.2.0.1 synopsis: Specify Haskell project templates and generate files description: See initial blog post for explanation: homepage: https://github.com/fpco/haskell-ide @@ -20,7 +20,7 @@ , bytestring >= 0.9 , transformers >= 0.2 , mtl >= 2.0 - , conduit >= 1.0 && < 1.3 + , conduit >= 1.2.8 && < 1.4 , conduit-extra , resourcet >= 0.4.3 , containers diff --git a/test/Text/ProjectTemplateSpec.hs b/test/Text/ProjectTemplateSpec.hs --- a/test/Text/ProjectTemplateSpec.hs +++ b/test/Text/ProjectTemplateSpec.hs @@ -5,8 +5,7 @@ import Test.Hspec.QuickCheck import Text.ProjectTemplate import Data.Conduit -import Control.Monad.Trans.Writer (execWriter) -import Control.Monad.Trans.Resource (runExceptionT_) +import Control.Monad.Trans.Writer (execWriterT) import Test.QuickCheck.Arbitrary import Data.Char (isAlphaNum) import qualified Data.ByteString.Base64 as B64 @@ -20,22 +19,22 @@ spec :: Spec spec = do describe "create/unpack" $ do - prop "is idempotent" $ \(Helper m) -> - let m' = - execWriter - $ runExceptionT_ + prop "is idempotent" $ \(Helper m) -> do + m' <- + execWriterT + $ runConduit $ mapM_ (yield . second return) (Map.toList m) - $$ createTemplate - =$ unpackTemplate receiveMem id - m'' = Map.fromList $ map (second $ mconcat . L.toChunks) $ Map.toList m' - in if m == m'' then True else error (show 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' -> + prop "works with multilines" $ \words' -> do let bs = S.pack words' encoded = B64.joinWith "\n" 5 $ B64.encode bs content = "{-# START_FILE BASE64 foo #-}\n" `mappend` encoded - m = execWriter $ runExceptionT_ $ yield content $$ unpackTemplate receiveMem id - in Map.lookup "foo" m == Just (L.fromChunks [bs]) + m <- execWriterT $ runConduit $ yield content .| unpackTemplate receiveMem id + Map.lookup "foo" m `shouldBe` Just (L.fromChunks [bs]) newtype Helper = Helper (Map.Map FilePath S.ByteString) deriving (Show, Eq)