yesod-gitrepo (empty) → 0.1.0.0

raw patch · 6 files changed

+271/−0 lines, 6 filesdep +basedep +directorydep +enclosed-exceptionssetup-changed

Dependencies added: base, directory, enclosed-exceptions, http-types, lifted-base, process, system-filepath, temporary, text, wai, yesod-core

Files

• ChangeLog.md +1/−0
• LICENSE +22/−0
• README.md +94/−0
• Setup.hs +2/−0
• Yesod/GitRepo.hs +124/−0
• yesod-gitrepo.cabal +28/−0

@@ -0,0 +1,1 @@+* __0.1.0.0__ Initial release

@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2014 Michael Snoyman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+

@@ -0,0 +1,94 @@+yesod-gitrepo+=============++yesod-gitrepo provides a means of embedding content from a Git repository+inside a Yesod application. The typical workflow is:++* Use `gitRepo` to specify a repository and branch you want to work with.+* Provide a function that will perform some processing on the cloned+  repository.+* Use `grContent` in your `Handler` functions to access this parsed data.+* Embed the `GitRepo` as a subsite that can be used to force a refresh of the+  data.+* Set up a commit handler that pings that URL. On Github, this would be a+  webhook.++This is likely easiest to understand with a concrete example, so let's go meta:+here's an application that will serve this very `README.md` file. We'll start+off with language extensions and imports:++```haskell+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeFamilies      #-}+import           ClassyPrelude.Yesod+import           Text.Markdown+import           Yesod.GitRepo+```++Now we're going to create our foundation datatype. We need to give it one+field: the `GitRepo` value containing our parsed content. Our content will+simply be the text inside `README.md`, wrapped up in a `Markdown` newtype for+easy rendering. This gives us:++```haskell+data App = App+    { getGitRepo :: GitRepo Markdown+    }++instance Yesod App+```++And now let's set up our routes. We need just two: a homepage, and the subsite.+Our subsite type is `GitRepo Markdown` (as given above). We replace the space+with a hyphen as an escaping mechanism inside Yesod's route syntax:++```haskell+mkYesod "App" [parseRoutes|+/ HomeR GET+/refresh RefreshR GitRepo-Markdown getGitRepo+|]+```++Next up is our home handler. We start off by getting the current content parsed+from the repository:++```haskell+getHomeR :: Handler Html+getHomeR = do+    master <- getYesod+    content <- liftIO $ grContent $ getGitRepo master+```++Then it's just some normal Hamlet code:++```haskell+    defaultLayout $ do+        setTitle "yesod-gitrepo sample"+        [whamlet|+            <p>+                <a href=@{RefreshR GitRepoRoute}>+                    Force a refresh at+                    @{RefreshR GitRepoRoute}+            <article>#{content}+        |]+```++And finally, our `main` function. We pass in the repo URL and branch name, plus+a function that, given the filepath containing the cloned repo, processes it+and generates a `Markdown` value. Finally, we provide the generated `repo`+value to our `App` constructor and run it:++```haskell+main :: IO ()+main = do+    repo <- gitRepo+        "https://github.com/snoyberg/yesod-gitrepo"+        "master"+        $ \fp -> fmap Markdown $ readFile $ fp </> "README.md"+    warp 3000 $ App repo+```++Give it a shot. You should have a webapp hosting this very README file!

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

@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude     #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeFamilies          #-}+module Yesod.GitRepo+    ( GitRepo+    , grRefresh+    , grContent+    , gitRepo+    , 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           Filesystem.Path.CurrentOS  (FilePath, decodeString,+                                             encodeString)+import           Network.HTTP.Types         (status200)+import           Network.Wai                (responseLBS)+import           Prelude                    (Eq, IO, Maybe (..), Monad (..),+                                             Read, Show, error, error, map,+                                             show, ($))+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"+    let contentDir = decodeString contentDir'+    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++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 = encodeString <$> 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,28 @@+name:                yesod-gitrepo+version:             0.1.0.0+synopsis:            Host content provided by a Git repo+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++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+                     , system-filepath+                     , text+                     , enclosed-exceptions+  default-language:    Haskell2010