diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,1 @@ +* __0.1.0.0__ Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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| +

+ + Force a refresh at + @{RefreshR GitRepoRoute} +

#{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! diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Yesod/GitRepo.hs b/Yesod/GitRepo.hs new file mode 100644 --- /dev/null +++ b/Yesod/GitRepo.hs @@ -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 + ] diff --git a/yesod-gitrepo.cabal b/yesod-gitrepo.cabal new file mode 100644 --- /dev/null +++ b/yesod-gitrepo.cabal @@ -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