extract title and description

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]",
+    challengeTitle=(T.pack $ title),
-    challengeDescription="[UNKNOWN DESCRIPTION]",
+    challengeDescription=(T.pack $ description),
     challengeStamp=time}
   return ()
 

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

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)