diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs index 80e209f..30fcd8f 100644 --- a/Handler/CreateChallenge.hs +++ b/Handler/CreateChallenge.hs @@ -5,6 +5,10 @@ import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, withSmallInput) import Handler.Shared +import Handler.Extract + +import System.Directory (doesFileExist) +import qualified Data.Text as T getCreateChallengeR :: Handler Html getCreateChallengeR = do @@ -41,13 +45,22 @@ doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do addChallenge :: Text -> (Key Repo) -> (Key Repo) -> Channel -> Handler () addChallenge name publicRepoId privateRepoId chan = do msg chan "adding challenge..." + let publicRepoDir = getRepoDir publicRepoId + let readmeFilePath = publicRepoDir readmeFile + doesReadmeExist <- liftIO $ doesFileExist readmeFilePath + (title, description) <- if doesReadmeExist + then + liftIO $ extractTitleAndDescription readmeFilePath + else do + err chan "README was not found" + return (defaultTitle, defaultDescription) time <- liftIO getCurrentTime challengeId <- runDB $ insert $ Challenge { challengePublicRepo=publicRepoId, challengePrivateRepo=privateRepoId, challengeName=name, - challengeTitle="[UNKNOWN TITLE]", - challengeDescription="[UNKNOWN DESCRIPTION]", + challengeTitle=(T.pack $ title), + challengeDescription=(T.pack $ description), challengeStamp=time} return () diff --git a/Handler/Extract.hs b/Handler/Extract.hs new file mode 100644 index 0000000..6e6b60d --- /dev/null +++ b/Handler/Extract.hs @@ -0,0 +1,54 @@ +module Handler.Extract where + +import Import + +import Text.Pandoc +import Text.Pandoc.Walk (walk) +import Text.Pandoc.Shared (stringify) + +import Data.Maybe + +import System.IO (withFile, IOMode(..)) + +extractHeaders :: Block -> [String] +extractHeaders (Header 1 _ x) = [stringify x] +extractHeaders _ = [] + +extractFirstHeader :: Pandoc -> Maybe String +extractFirstHeader doc = case queryWith extractHeaders doc of + (s:_) -> Just s + [] -> Nothing + +extractParas :: Block -> [String] +extractParas (Para x) = [stringify x] +extractParas _ = [] + +extractFirstPara :: Pandoc -> Maybe String +extractFirstPara doc = case queryWith extractParas doc of + (s:_) -> Just s + [] -> Nothing + +readDoc :: String -> Pandoc +readDoc s = case readMarkdown def s of + Right doc -> doc + Left err -> error (show err) + +defaultTitle :: String +defaultTitle = "[???]" + +defaultDescription :: String +defaultDescription = "" + +readmeFile :: FilePath +readmeFile = "README.md" + +getTitleAndDescription :: String -> (String, String) +getTitleAndDescription contents = (title, description) + where title = fromMaybe defaultTitle $ extractFirstHeader doc + description = fromMaybe defaultDescription $ extractFirstPara doc + doc = readDoc contents + +extractTitleAndDescription :: FilePath -> IO (String, String) +extractTitleAndDescription fp = do + contents <- readFile fp + return $ getTitleAndDescription contents diff --git a/gonito.cabal b/gonito.cabal index 61937e3..aad4ff0 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -27,6 +27,7 @@ library Handler.Fay Handler.Home Handler.Shared + Handler.Extract if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT @@ -94,7 +95,8 @@ library , lifted-base , process , random - + , pandoc + , pandoc-types executable gonito if flag(library-only)