Create posts directory if needed

[blog.git] / Main.hs

diff --git a/Main.hs b/Main.hs
index e6f0aaec3661f7531abfa05407eefb5f559830fe..24e201726f653d994b9ea53c63f69419b358bdd3 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -11,6 +11,7 @@ import qualified Data.Map.Lazy as Map
 import Data.Maybe
 import Data.Ord
 import Data.IORef
+import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
@@ -24,11 +25,13 @@ import Lucid.Base
 import System.Directory
 import System.FilePath
 import System.Random
+import System.IO.Error
 import Network.HTTP.Types
 
 type Sessions = Map.Map T.Text T.Text
 type ActionM = ActionT T.Text (S.StateT Sessions IO)
 
+-- | Checks if the user is logged in
 loggedIn :: ActionM Bool
 loggedIn = do
   mCookie <- getCookie "session"
@@ -36,6 +39,7 @@ loggedIn = do
     Nothing -> return False
     Just cookie -> Map.member (T.fromStrict cookie) <$> lift S.get
 
+-- | Returns the current username
 currentUser :: ActionM (Maybe T.Text)
 currentUser = do
   mCookie <- getCookie "session"
@@ -66,6 +70,7 @@ logins = Map.fromList
 main :: IO ()
 main = do
   preserve <- mkPreserve mempty
+  createDirectory "posts" `catch` (\e -> unless (isAlreadyExistsError e) (throw e))
   scottyT 3000 preserve $ do
     get "/style.css" $ file "style.css"
 
@@ -74,25 +79,29 @@ main = do
       if authed
         then template "Create" $ do
           h1_ "Create a new post"
-          with form_ [action_ "create", method_ "post"] $ do
+          form_ [action_ "create", method_ "post"] $ do
             input_ [name_ "title", type_ "text", placeholder_ "Title"]
             br_ []
-            with textarea_ [name_ "body", placeholder_ "# Your markdown here"] ""
+            textarea_ [name_ "body", placeholder_ "# Your markdown here"] ""
             br_ []
-            input_ [type_ "submit"]
-        else status unauthorized401
+            input_ [type_ "submit", value_ "Post"]
+        else do
+          text "You're not logged in"
+          status unauthorized401
 
     post "/create" $ do
       t <- param "title"
       b <- param "body"
-      p <- createPost b t
+      p <- createPost t b
       redirect (linkToPost p)
 
     post "/login" $ do
       username <- param "username"
       password <- param "password"
       if Map.lookup username logins /= Just password
-        then status unauthorized401
+        then do
+          text "Invalid username and/or password"
+          status unauthorized401
         else do
           session <- T.pack . show <$> liftIO (randomIO :: IO Int)
           lift $ S.modify (Map.insert session username)
@@ -128,13 +137,13 @@ template title content = do
         a_ [href_ "/"] "🏠 Cool Blog"
         if authed
           then do
-            a_ [href_ "/create"] "Create a Post"
-            with form_ [action_ "/logout", method_ "post", class_ "login-form"] $
+            "   " >> a_ [href_ "/create"] "Create a Post"
+            form_ [action_ "/logout", method_ "post", class_ "login-form"] $
               input_ [type_ "submit", value_ "Log Out"]
-          else with form_ [action_ "/login", method_ "post", class_ "login-form"] $ do
+          else form_ [action_ "/login", method_ "post", class_ "login-form"] $ do
             input_ [name_ "username", placeholder_ "Username", type_ "text"]
             input_ [name_ "password", placeholder_ "Password", type_ "password"]
-            input_ [type_ "submit"]
+            input_ [type_ "submit", value_ "Log In"]
       content
   where style = link_ [Attribute "rel" "stylesheet", Attribute "href" "/style.css"]
 
@@ -156,12 +165,12 @@ render p@(Post markdown title date author) =
   case M.parse (pathToPost p) (T.toStrict markdown) of
     Left e -> Nothing
     Right doc -> Just $
-      with article_ [id_ (T.toStrict title)] $ do
+      article_ [id_ (T.toStrict title)] $ do
         header_ $ do
-          with a_ [href_ (T.toStrict $ linkToPost p)] $
+          a_ [href_ (T.toStrict $ linkToPost p)] $
             h1_ $ toHtml title
           address_ $ "By " >> toHtml author
-          with time_ [datetime_ (T.toStrict $ T.pack (show date))] $ toHtml dateStr
+          time_ [datetime_ (T.toStrict $ T.pack (show date))] $ toHtml dateStr
         M.render (M.useExtensions extensions doc)
   where extensions = [M.ghcSyntaxHighlighter, M.skylighting, M.footnotes]
         dateStr = T.pack $ formatTime defaultTimeLocale "%a %e %B %Y" date
@@ -172,8 +181,14 @@ linkToPost p = T.pack $ "/posts" </> kebab (T.unpack (title p))
 pathToPost :: Post -> FilePath
 pathToPost p = "posts" </> kebab (T.unpack (title p))
 
-createPost :: T.Text -> T.Text -> ActionM Post
-createPost md title = do
+-- | Creates and saves a new post
+createPost :: T.Text
+           -- ^ The title of the post
+           -> T.Text
+           -- ^ The markdown body
+           -> ActionM Post
+           -- ^ The freshly created post
+createPost title md = do
   author <- do
     ma <- currentUser
     case ma of