{-# LANGUAGE OverloadedStrings #-}

module Hakyll.Convert.IO where

import qualified Data.ByteString as B
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Format (defaultTimeLocale, formatTime)
import Hakyll.Convert.Common (DistilledPost (..))
import Hakyll.Convert.OutputFormat (formatPath)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (takeDirectory, takeFileName, (<.>), (</>))

-- | Save a post along with its comments in a format that Hakyll understands.
--
-- Returns the filename of the file that was written.
savePost :: FilePath -> T.Text -> T.Text -> DistilledPost -> IO FilePath
savePost :: FilePath -> Text -> Text -> DistilledPost -> IO FilePath
savePost FilePath
odir Text
oformat Text
ext DistilledPost
post = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
fname)
  FilePath -> ByteString -> IO ()
B.writeFile FilePath
fname (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
T.unlines
      [ Text
"---",
        Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
metadata Text
"title" (Maybe Text -> Text
formatTitle (DistilledPost -> Maybe Text
dpTitle DistilledPost
post)),
        Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
metadata Text
"published" (UTCTime -> Text
formatDate (DistilledPost -> UTCTime
dpDate DistilledPost
post)),
        Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
metadata Text
"categories" ([Text] -> Text
formatTags (DistilledPost -> [Text]
dpCategories DistilledPost
post)),
        Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
metadata Text
"tags" ([Text] -> Text
formatTags (DistilledPost -> [Text]
dpTags DistilledPost
post)),
        Text
"---",
        Text
"",
        Text -> Text
forall a. a -> a
formatBody (DistilledPost -> Text
dpBody DistilledPost
post)
      ]

  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fname
  where
    metadata :: a -> a -> a
metadata a
k a
v = a
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
": " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
v
    --
    fname :: FilePath
fname = FilePath
odir FilePath -> FilePath -> FilePath
</> FilePath
postPath FilePath -> FilePath -> FilePath
<.> (Text -> FilePath
T.unpack Text
ext)
    postPath :: FilePath
postPath = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> DistilledPost -> Maybe Text
formatPath Text
oformat DistilledPost
post
    --
    formatTitle :: Maybe Text -> Text
formatTitle (Just Text
t) = Text
t
    formatTitle Maybe Text
Nothing =
      Text
"untitled (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
firstFewWords Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…)"
      where
        firstFewWords :: [Text]
firstFewWords = Text -> Text -> [Text]
T.splitOn Text
"-" (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> [Text]) -> FilePath -> [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
postPath
    formatDate :: UTCTime -> Text
formatDate = FilePath -> Text
T.pack (FilePath -> Text) -> (UTCTime -> FilePath) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%FT%TZ" --for hakyll
    formatTags :: [Text] -> Text
formatTags = Text -> [Text] -> Text
T.intercalate Text
","
    formatBody :: a -> a
formatBody = a -> a
forall a. a -> a
id