<commit_before>module Helpers.Post
    ( postForm
    , upsertPost
    , postContent
    , postPublished
    , getPost404
    , getPreviousPost
    , getNextPost
    ) where

import Import
import Helpers.Fields
import Control.Monad (forM_)
import Data.Time.Format.Human
import System.Directory (doesFileExist)
import Yesod.Markdown
import Data.Time (getCurrentTime)
import qualified Data.Text as T

data PostForm = PostForm
    { pfSlug     :: Text
    , pfTitle    :: Text
    , pfTags     :: Text
    , pfDescr    :: Maybe Markdown
    , pfDraft    :: Bool
    , pfWasDraft :: Bool
    }

postForm :: Maybe (Post,[Tag]) -> Form PostForm
postForm mpost = renderBootstrap $ PostForm
    <$> areq textField     "Slug"        (fmap (postSlug   . fst) mpost)
    <*> areq textField     "Title"       (fmap (postTitle  . fst) mpost)
    <*> areq textField     "Tags"        (fmap (formatTags . snd) mpost)
    <*> aopt markdownField "Description" (fmap (postDescr  . fst) mpost)
    <*> areq checkBoxField "Draft?"      (Just $ isDraft mpost)
    <*> pure (isDraft mpost) -- store prev value

    where
        formatTags :: [Tag] -> Text
        formatTags = T.intercalate ", " . map tagName

        -- use draft value when present, defult True on Nothing
        isDraft :: Maybe (Post,[Tag]) -> Bool
        isDraft = maybe True (postDraft . fst)

upsertPost :: PostForm -> Handler ()
upsertPost pf = do
    now <- liftIO getCurrentTime

    let post = Post
                { postSlug  = pfSlug  pf
                , postTitle = pfTitle pf
                , postDescr = pfDescr pf
                , postDate  = now
                , postDraft = pfDraft pf
                }

    msg <- runDB $ do
        result <- insertBy post

        case result of
            Right k -> do
                -- post was inserted, add the tags
                forM_ (parseTags $ pfTags pf) $ \tag -> do
                    insertBy $ Tag k tag

                return "post created!"

            Left (Entity k _) -> do
                -- post exists, update it
                update k $
                    [ PostSlug  =. pfSlug  pf
                    , PostTitle =. pfTitle pf
                    , PostDescr =. pfDescr pf
                    , PostDraft =. pfDraft pf

                    -- update post date if were changing a post from
                    -- draft to not draft.
                    ] ++ dateUpd (pfWasDraft pf) (pfDraft pf) now

                -- remove existing tags
                deleteWhere [TagPost ==. k]

                -- add new ones
                forM_ (parseTags $ pfTags pf) $ \tag -> do
                    insertBy $ Tag k tag

                return "post updated!"

    setMessage msg

    redirect ManagePostsR

    where
        parseTags :: Text -> [Text]
        parseTags = filter (not . T.null)
                  . map (T.toLower . T.strip) . T.splitOn ","

        dateUpd True False date = [PostDate =. date]
        dateUpd _    _     _    = []

postContent :: Post -> IO Html
postContent post = do
    let file = pandocFile $ postSlug post

    exists <- doesFileExist file
    mkd    <- case (exists, postDescr post) of
        (True, _         ) -> markdownFromFile file
        (_   , Just descr) -> return descr
        _                  -> return $ Markdown "nothing?"

    return $ markdownToHtml mkd

postPublished :: Post -> IO String
postPublished = humanReadableTime . postDate

getPost404 :: Text -> YesodDB DevSite DevSite (Post,[Tag])
getPost404 slug = do
    (Entity key val) <- getBy404 $ UniquePost slug
    tags' <- selectList [TagPost ==. key] [Asc TagName]

    return (val, map entityVal tags')

getNextPost :: Post -> YesodDB DevSite DevSite (Maybe Post)
getNextPost post = do
    posts <- selectList [PostDate <. postDate post] [Desc PostDate, LimitTo 1]
    return $ case posts of
        ((Entity _ p):_) -> Just p
        _                -> Nothing

getPreviousPost :: Post -> YesodDB DevSite DevSite (Maybe Post)
getPreviousPost post = do
    posts <- selectList [PostDate >. postDate post] [Asc PostDate, LimitTo 1]
    return $ case posts of
        ((Entity _ p):_) -> Just p
        _                -> Nothing<commit_msg>avoid drafts in post navigation<commit_after>module Helpers.Post
    ( postForm
    , upsertPost
    , postContent
    , postPublished
    , getPost404
    , getPreviousPost
    , getNextPost
    ) where

import Import
import Helpers.Fields
import Control.Monad (forM_)
import Data.Time.Format.Human
import System.Directory (doesFileExist)
import Yesod.Markdown
import Data.Time (getCurrentTime)
import qualified Data.Text as T

data PostForm = PostForm
    { pfSlug     :: Text
    , pfTitle    :: Text
    , pfTags     :: Text
    , pfDescr    :: Maybe Markdown
    , pfDraft    :: Bool
    , pfWasDraft :: Bool
    }

postForm :: Maybe (Post,[Tag]) -> Form PostForm
postForm mpost = renderBootstrap $ PostForm
    <$> areq textField     "Slug"        (fmap (postSlug   . fst) mpost)
    <*> areq textField     "Title"       (fmap (postTitle  . fst) mpost)
    <*> areq textField     "Tags"        (fmap (formatTags . snd) mpost)
    <*> aopt markdownField "Description" (fmap (postDescr  . fst) mpost)
    <*> areq checkBoxField "Draft?"      (Just $ isDraft mpost)
    <*> pure (isDraft mpost) -- store prev value

    where
        formatTags :: [Tag] -> Text
        formatTags = T.intercalate ", " . map tagName

        -- use draft value when present, defult True on Nothing
        isDraft :: Maybe (Post,[Tag]) -> Bool
        isDraft = maybe True (postDraft . fst)

upsertPost :: PostForm -> Handler ()
upsertPost pf = do
    now <- liftIO getCurrentTime

    let post = Post
                { postSlug  = pfSlug  pf
                , postTitle = pfTitle pf
                , postDescr = pfDescr pf
                , postDate  = now
                , postDraft = pfDraft pf
                }

    msg <- runDB $ do
        result <- insertBy post

        case result of
            Right k -> do
                -- post was inserted, add the tags
                forM_ (parseTags $ pfTags pf) $ \tag -> do
                    insertBy $ Tag k tag

                return "post created!"

            Left (Entity k _) -> do
                -- post exists, update it
                update k $
                    [ PostSlug  =. pfSlug  pf
                    , PostTitle =. pfTitle pf
                    , PostDescr =. pfDescr pf
                    , PostDraft =. pfDraft pf

                    -- update post date if were changing a post from
                    -- draft to not draft.
                    ] ++ dateUpd (pfWasDraft pf) (pfDraft pf) now

                -- remove existing tags
                deleteWhere [TagPost ==. k]

                -- add new ones
                forM_ (parseTags $ pfTags pf) $ \tag -> do
                    insertBy $ Tag k tag

                return "post updated!"

    setMessage msg

    redirect ManagePostsR

    where
        parseTags :: Text -> [Text]
        parseTags = filter (not . T.null)
                  . map (T.toLower . T.strip) . T.splitOn ","

        dateUpd True False date = [PostDate =. date]
        dateUpd _    _     _    = []

postContent :: Post -> IO Html
postContent post = do
    let file = pandocFile $ postSlug post

    exists <- doesFileExist file
    mkd    <- case (exists, postDescr post) of
        (True, _         ) -> markdownFromFile file
        (_   , Just descr) -> return descr
        _                  -> return $ Markdown "nothing?"

    return $ markdownToHtml mkd

postPublished :: Post -> IO String
postPublished = humanReadableTime . postDate

getPost404 :: Text -> YesodDB DevSite DevSite (Post,[Tag])
getPost404 slug = do
    (Entity key val) <- getBy404 $ UniquePost slug
    tags' <- selectList [TagPost ==. key] [Asc TagName]

    return (val, map entityVal tags')

getNextPost :: Post -> YesodDB DevSite DevSite (Maybe Post)
getNextPost post = do
    posts <- selectList [PostDraft !=. True, PostDate <. postDate post] [Desc PostDate, LimitTo 1]
    return $ case posts of
        ((Entity _ p):_) -> Just p
        _                -> Nothing

getPreviousPost :: Post -> YesodDB DevSite DevSite (Maybe Post)
getPreviousPost post = do
    posts <- selectList [PostDraft !=. True, PostDate >. postDate post] [Asc PostDate, LimitTo 1]
    return $ case posts of
        ((Entity _ p):_) -> Just p
        _                -> Nothing
{'fraction_non_alphanumeric': 0.09183431952662723, 'fraction_numerical': 0.0033136094674556214, 'mean_word_length': 1.678605388272583, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2796171', 'n_tokens_mistral': 2627, 'n_tokens_neox': 2448, 'n_words': 785}