yesod-gitrepo 0.2.1.0 → 0.3.0

raw patch · 5 files changed

+183/−160 lines, 5 filesdep +unliftiodep −enclosed-exceptionsdep −lifted-basedep ~basedep ~temporarydep ~yesod-corePVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio

Dependencies removed: enclosed-exceptions, lifted-base

Dependency ranges changed: base, temporary, yesod-core

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +3/−0
• Yesod/GitRepo.hs +0/−134
• src/Yesod/GitRepo.hs +132/−0
• yesod-gitrepo.cabal +44/−26

@@ -1,3 +1,7 @@+## 0.3.0++* Support yesod-core 1.6+ ## 0.2.1.0  * Add back some missing changes from 0.1.1.0

@@ -1,6 +1,9 @@ yesod-gitrepo ============= +[![Build Status](https://travis-ci.org/snoyberg/yesod-gitrepo.svg?branch=master)](https://travis-ci.org/snoyberg/yesod-gitrepo)+[![Build status](https://ci.appveyor.com/api/projects/status/l7vapfikbowucr2x/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/yesod-gitrepo/branch/master)+ yesod-gitrepo provides a means of embedding content from a Git repository inside a Yesod application. The typical workflow is: 

@@ -1,134 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoImplicitPrelude     #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeFamilies          #-}-module Yesod.GitRepo-    ( GitRepo-    , grRefresh-    , grContent-    , gitRepo-    , gitRepoDev-    , Route (..)-    ) where--import           Control.Applicative        ((<$>))-import           Control.Concurrent         (forkIO)-import           Control.Concurrent.MVar    (newEmptyMVar, takeMVar, tryPutMVar)-import           Control.Exception          (mask_)-import           Control.Exception.Enclosed (tryAny)-import           Control.Monad              (forever, void)-import           Data.Foldable              (fold)-import           Data.IORef                 (newIORef, readIORef, writeIORef)-import           Data.Monoid                ((<>))-import           Data.Text                  (Text, pack, unpack)-import           Network.HTTP.Types         (status200)-import           Network.Wai                (responseLBS)-import           Prelude                    (Eq, IO, Maybe (..), Monad (..),-                                             Read, Show, error, error, map,-                                             show, ($), FilePath)-import           System.Directory           (getTemporaryDirectory,-                                             removeDirectory)-import           System.Exit                (ExitCode (ExitSuccess, ExitFailure))-import           System.IO.Temp             (createTempDirectory)-import           System.Process             (createProcess, cwd, proc,-                                             waitForProcess)-import           Yesod.Core                 (ParseRoute (..), RenderRoute (..),-                                             YesodSubDispatch (..), typePlain)-import           Yesod.Core.Types           (HandlerT, yreSite, ysreGetSub,-                                             ysreParentEnv)---- | A combination of Yesod subsite to be used for creating a refresh route, as--- well as action to extract the current value of the content and force a--- refresh.------ Since 0.1.0-data GitRepo a = GitRepo-    { grRefresh :: IO ()-    -- ^ Force a refresh of the content. Usually this is done automatically via-    -- a POST request to the subsite route.-    ---    -- Since 0.1.0-    , grContent :: IO a-    -- ^ Get the current value of the content.-    ---    -- Since 0.1.0-    }---- | Create a new @GitRepo@ value that can be used as a refresh subsite, as--- well as to extract the current value of the content.------ Note that if the initial clone or user action fails, this function will--- throw an exception. For subsequent refreshes, the exception will be stored--- as an impure exception for future @grContent@ calls.------ Since 0.1.0-gitRepo :: Text -- ^ URL-           -> Text -- ^ branch name-           -> (FilePath -> IO a) -- ^ what to do on clone/refresh-           -> IO (GitRepo a)-gitRepo url branch refresh = do-    tmpDir <- getTemporaryDirectory-    contentDir <- createTempDirectory tmpDir "git-repo"-    removeDirectory contentDir-    git Nothing ["clone", "-b", branch, url, pack contentDir]-    ref <- refresh contentDir >>= newIORef-    var <- newEmptyMVar-    mask_ $ void $ forkIO $ forever $ do-        takeMVar var-        void $ tryAny $ do-            git (Just contentDir) ["fetch"]-            git (Just contentDir) ["reset", "--hard", "origin/" <> branch]-            refresh contentDir >>= writeIORef ref--    return GitRepo-        { grRefresh = void $ tryPutMVar var ()-        , grContent = readIORef ref-        }--instance RenderRoute (GitRepo a) where-    data Route (GitRepo a) = GitRepoRoute-        deriving (Show, Eq, Read)-    renderRoute _ = ([], [])--instance ParseRoute (GitRepo a) where-    parseRoute ([], []) = Just GitRepoRoute-    parseRoute _ = Nothing---- | Like 'gitRepo', but intended to be used in a dev environment. It just uses--- a hard-coded @FilePath@ and reloads the contents on each request.------ Since 0.1.1-gitRepoDev :: FilePath-           -> (FilePath -> IO a)-           -> IO (GitRepo a)-gitRepoDev fp refresh = return GitRepo-    { grRefresh = return ()-    , grContent = refresh fp-    }--instance YesodSubDispatch (GitRepo a) (HandlerT site IO) where-    yesodSubDispatch env _req send = do-        void $ forkIO $ grRefresh gr-        send $ responseLBS status200 [("Content-Type", typePlain)]-            "Reload initiated"-      where-        gr = ysreGetSub env $ yreSite $ ysreParentEnv env--git :: Maybe FilePath -> [Text] -> IO ()-git mdir args = do-    (Nothing, Nothing, Nothing, ph) <- createProcess-        (proc "git" $ map unpack args)-            { cwd = mdir-            }-    ec <- waitForProcess ph-    case ec of-        ExitSuccess -> return ()-        ExitFailure i -> error $ fold-            [ "Ran git in dir "-            , show mdir-            , " with args "-            , show args-            , " failed with exit code "-            , show i-            ]

@@ -0,0 +1,132 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude     #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeFamilies          #-}+module Yesod.GitRepo+    ( GitRepo+    , grRefresh+    , grContent+    , gitRepo+    , gitRepoDev+    , Route (..)+    ) where++import           Control.Applicative        ((<$>))+import           Control.Concurrent         (forkIO)+import           Control.Monad              (forever, void)+import           Data.Foldable              (fold)+import           Data.Monoid                ((<>))+import           Data.Text                  (Text, pack, unpack)+import           Network.HTTP.Types         (status200)+import           Network.Wai                (responseLBS)+import           Prelude                    (Eq, IO, Maybe (..), Monad (..),+                                             Read, Show, error, error, map,+                                             show, ($), FilePath)+import           System.Directory           (getTemporaryDirectory,+                                             removeDirectory)+import           System.Exit                (ExitCode (ExitSuccess, ExitFailure))+import           UnliftIO+import qualified System.IO.Temp+import           System.Process             (createProcess, cwd, proc,+                                             waitForProcess)+import           Yesod.Core                 (ParseRoute (..), RenderRoute (..),+                                             YesodSubDispatch (..), typePlain,+                                             HandlerFor)+import           Yesod.Core.Types           (yreSite, ysreGetSub,+                                             ysreParentEnv)++-- | A combination of Yesod subsite to be used for creating a refresh route, as+-- well as action to extract the current value of the content and force a+-- refresh.+--+-- Since 0.1.0+data GitRepo a = GitRepo+    { grRefresh :: IO ()+    -- ^ Force a refresh of the content. Usually this is done automatically via+    -- a POST request to the subsite route.+    --+    -- Since 0.1.0+    , grContent :: IO a+    -- ^ Get the current value of the content.+    --+    -- Since 0.1.0+    }++-- | Create a new @GitRepo@ value that can be used as a refresh subsite, as+-- well as to extract the current value of the content.+--+-- Note that if the initial clone or user action fails, this function will+-- throw an exception. For subsequent refreshes, the exception will be stored+-- as an impure exception for future @grContent@ calls.+--+-- Since 0.1.0+gitRepo :: Text -- ^ URL+           -> Text -- ^ branch name+           -> (FilePath -> IO a) -- ^ what to do on clone/refresh+           -> IO (GitRepo a)+gitRepo url branch refresh = do+    tmpDir <- getTemporaryDirectory+    contentDir <- System.IO.Temp.createTempDirectory tmpDir "git-repo"+    removeDirectory contentDir+    git Nothing ["clone", "-b", branch, url, pack contentDir]+    ref <- refresh contentDir >>= newIORef+    var <- newEmptyMVar+    mask_ $ void $ forkIO $ forever $ do+        takeMVar var+        void $ tryAny $ do+            git (Just contentDir) ["fetch"]+            git (Just contentDir) ["reset", "--hard", "origin/" <> branch]+            refresh contentDir >>= writeIORef ref++    return GitRepo+        { grRefresh = void $ tryPutMVar var ()+        , grContent = readIORef ref+        }++instance RenderRoute (GitRepo a) where+    data Route (GitRepo a) = GitRepoRoute+        deriving (Show, Eq, Read)+    renderRoute _ = ([], [])++instance ParseRoute (GitRepo a) where+    parseRoute ([], []) = Just GitRepoRoute+    parseRoute _ = Nothing++-- | Like 'gitRepo', but intended to be used in a dev environment. It just uses+-- a hard-coded @FilePath@ and reloads the contents on each request.+--+-- Since 0.1.1+gitRepoDev :: FilePath+           -> (FilePath -> IO a)+           -> IO (GitRepo a)+gitRepoDev fp refresh = return GitRepo+    { grRefresh = return ()+    , grContent = refresh fp+    }++instance YesodSubDispatch (GitRepo a) site where+    yesodSubDispatch env _req send = do+        void $ forkIO $ grRefresh gr+        send $ responseLBS status200 [("Content-Type", typePlain)]+            "Reload initiated"+      where+        gr = ysreGetSub env $ yreSite $ ysreParentEnv env++git :: Maybe FilePath -> [Text] -> IO ()+git mdir args = do+    (Nothing, Nothing, Nothing, ph) <- createProcess+        (proc "git" $ map unpack args)+            { cwd = mdir+            }+    ec <- waitForProcess ph+    case ec of+        ExitSuccess -> return ()+        ExitFailure i -> error $ fold+            [ "Ran git in dir "+            , show mdir+            , " with args "+            , show args+            , " failed with exit code "+            , show i+            ]

@@ -1,28 +1,46 @@-name:                yesod-gitrepo-version:             0.2.1.0-synopsis:            Host content provided by a Git repo-description:         See README.md-homepage:            https://github.com/snoyberg/yesod-gitrepo-license:             MIT-license-file:        LICENSE-author:              Michael Snoyman-maintainer:          michael@snoyman.com-category:            Web-build-type:          Simple-extra-source-files:  README.md-                     ChangeLog.md-cabal-version:       >=1.10+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 71987855e877993e60d8044cd8a7a476541cdc9f3dd5ecfa900311d0fd5dcd01 +name:           yesod-gitrepo+version:        0.3.0+synopsis:       Host content provided by a Git repo+description:    Please see the README and generated docs at <https://www.stackage.org/package/yesod-gitrepo>+category:       Web+homepage:       https://github.com/snoyberg/yesod-gitrepo#readme+bug-reports:    https://github.com/snoyberg/yesod-gitrepo/issues+author:         Michael Snoyman+maintainer:     michael@snoyman.com+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/snoyberg/yesod-gitrepo+ library-  exposed-modules:     Yesod.GitRepo-  build-depends:       base < 5-                     , temporary >=1.2-                     , directory-                     , yesod-core >=1.2 && <1.5-                     , wai >=3.0-                     , http-types-                     , process >=1.1-                     , lifted-base-                     , text-                     , enclosed-exceptions-  default-language:    Haskell2010+  hs-source-dirs:+      src+  build-depends:+      base >=4.9 && <10+    , directory+    , http-types+    , process >=1.1+    , temporary+    , text+    , unliftio+    , wai >=3.0+    , yesod-core >=1.6 && <1.7+  exposed-modules:+      Yesod.GitRepo+  other-modules:+      Paths_yesod_gitrepo+  default-language: Haskell2010