From f3a473d83ec48161bceda09d2bfc342efb13130d Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@ceti.pl>
Date: Fri, 4 Sep 2015 15:10:47 +0200
Subject: [PATCH] extract title and description

---
 Handler/CreateChallenge.hs | 17 ++++++++++--
 Handler/Extract.hs         | 54 ++++++++++++++++++++++++++++++++++++++
 gonito.cabal               |  4 ++-
 3 files changed, 72 insertions(+), 3 deletions(-)
 create mode 100644 Handler/Extract.hs

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)