extract title and description

This commit is contained in:
Filip Gralinski 2015-09-04 15:10:47 +02:00
parent b148cc37fc
commit f3a473d83e
3 changed files with 72 additions and 3 deletions

View File

@ -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 ()

54
Handler/Extract.hs Normal file
View File

@ -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

View File

@ -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)