{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Gemoire.Gemlog
-- Copyright   :  (c) 2024 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- A tiny static gemlog generator
--
-- To make a gemlog, you need two essential types of materials: posts and
-- templates.
--
-- The template syntax detailed in `Gemoire.Template' is also usable in posts.
-- The posts processed using this module have some special variables available
-- to them while generating. Those are, including others:
--
--     * @title@ - The first heading in the document if it exists
--     * @path@ - The given file path /(non-overrideable)/
--     * @fname@ - The file name without the extension and the directories
--     * @modified@ - File modification date and time (@yyyy-mm-ddThh:mm:ss[.ss]±hh:mm@)
--     * @modified_date@ - File modification date (@yyyy-mm-dd@)
--     * @url@ - The permanent link to post /(non-overrideable)/
--     * @gemlog@ - The title of the gemlog /(non-overrideable)/
--     * @author@ - The author of the gemlog /(non-overrideable)/
--
-- Additionally, variables can also be set (or overridden) in the post like so,
-- assuming a /single variable per line/:
--
--     > {= variable value =}
--
-- For the templates, see `Gemoire.Template'. However, as with posts, feeds also
-- have special variables available. Those are, for the /feed itself/:
--
--     * @title@ - The title of the gemlog
--     * @author@ - The author of the gemlog
--     * @base@ - The base URL of the gemlog
--     * @url@ - The permanent link to the feed
--     * @entries@ - The formatted entries
--
-- For each entry in the feed, every variable the post associated with the entry has
-- is available.
--
-- See the README.md for a roughly step-by-step guide.
module Gemoire.Gemlog
    ( -- * Gemlog generation
      Gemlog (..)
    , generatePosts
    , generateGemfeed
    , generateAtom

      -- * Re-exports
    , defPost
    , defGemfeed
    , defGemfeedEntry
    , defAtom
    , defAtomEntry
    ) where

import Data.Bool (bool)
import Data.HashMap.Strict (findWithDefault, fromList, singleton)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
import System.Directory.Extra (listFilesRecursive)
import System.FilePath (takeExtension, takeFileName, (</>))

import Gemoire.Gemlog.Feed
    ( defAtom
    , defAtomEntry
    , defGemfeed
    , defGemfeedEntry
    , escapeFeed
    , lastModified
    , sortPosts
    )
import Gemoire.Gemlog.Post (defPost, readPost)
import Gemoire.Template (Template, Values, format)

-- | A gemlog recipe to generate files for
data Gemlog = Gemlog
    { Gemlog -> Text
title :: !Text
    -- ^ The title of the gemlog
    , Gemlog -> Text
author :: !Text
    -- ^ The author of the gemlog
    , Gemlog -> String
sourceDir :: !FilePath
    -- ^ The source directory for posts, scanned recursively,
    -- /not/ retaining the directory structure
    , Gemlog -> Text
baseURL :: !Text
    -- ^ The base URL of the gemlog
    , Gemlog -> Template
postTemplate :: Template
    -- ^ The post template
    , Gemlog -> (Template, Template)
gemfeedTemplates :: (Template, Template)
    -- ^ The gemfeed templates, where the first is the feed itself
    -- and the second is a single entry
    , Gemlog -> (Template, Template)
atomTemplates :: (Template, Template)
    -- ^ The Atom feed templates, where the first is the feed itself
    -- and the second is a single entry
    , Gemlog -> Values
overrides :: !Values
    }
    deriving (Int -> Gemlog -> ShowS
[Gemlog] -> ShowS
Gemlog -> String
(Int -> Gemlog -> ShowS)
-> (Gemlog -> String) -> ([Gemlog] -> ShowS) -> Show Gemlog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Gemlog -> ShowS
showsPrec :: Int -> Gemlog -> ShowS
$cshow :: Gemlog -> String
show :: Gemlog -> String
$cshowList :: [Gemlog] -> ShowS
showList :: [Gemlog] -> ShowS
Show, Gemlog -> Gemlog -> Bool
(Gemlog -> Gemlog -> Bool)
-> (Gemlog -> Gemlog -> Bool) -> Eq Gemlog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Gemlog -> Gemlog -> Bool
== :: Gemlog -> Gemlog -> Bool
$c/= :: Gemlog -> Gemlog -> Bool
/= :: Gemlog -> Gemlog -> Bool
Eq)

-- | Generates and writes all the posts in the given `Gemlog' to the given directory.
--
-- The output directory is /flat/ and the structure of the source is /never/ retained.
--
-- See the module description for the variables available in the post.
generatePosts :: Gemlog -> FilePath -> IO ()
generatePosts :: Gemlog -> String -> IO ()
generatePosts glog :: Gemlog
glog@(Gemlog{Template
postTemplate :: Gemlog -> Template
postTemplate :: Template
postTemplate}) String
outputDir = do
    [Values]
posts <- Gemlog -> IO [Values]
parsePosts Gemlog
glog
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
outputDir
    (Values -> IO ()) -> [Values] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Values
p -> String -> String -> IO ()
writeFile (String
outputDir String -> ShowS
</> Values -> String
fileName Values
p) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
crlf (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Template -> Values -> Text
format Template
postTemplate Values
p) [Values]
posts

-- | Generates a gemfeed in the given path.
--
-- See the module description for the variables available in the feed.
--
-- If the given path is a directory, the feed file will be named
-- @index.gmi@ by default.
--
-- The entries are sorted by last modified in the feed. Every variable in the
-- post is available in its respective entry. See `generatePosts' above.
generateGemfeed :: Gemlog -> FilePath -> IO ()
generateGemfeed :: Gemlog -> String -> IO ()
generateGemfeed = Bool -> Gemlog -> String -> IO ()
generateFeed Bool
True

-- | Generates an feed Atom in the given path.
--
-- See the module description for the variables available in the feed.
--
-- If the given path is a directory, the feed file will be named
-- @atom.xml@ by default.
--
-- The entries are sorted by last modified in the feed. Every variable in the post
-- is available in its respective entry. See `generatePosts' above.
--
-- Additionally, every variable is escaped to make the XML valid. Variables ending with
-- @url@ are escaped using percent encodings for URLs instead of ampersand. See `escapeAtom'.
generateAtom :: Gemlog -> FilePath -> IO ()
generateAtom :: Gemlog -> String -> IO ()
generateAtom = Bool -> Gemlog -> String -> IO ()
generateFeed Bool
False

-- The first parameter is @True@ for gemfeeds and @False@ for Atom.
-- Adds some additional variables described above.
generateFeed :: Bool -> Gemlog -> FilePath -> IO ()
generateFeed :: Bool -> Gemlog -> String -> IO ()
generateFeed Bool
gemfeed glog :: Gemlog
glog@(Gemlog{Text
title :: Gemlog -> Text
title :: Text
title, Text
author :: Gemlog -> Text
author :: Text
author, Text
baseURL :: Gemlog -> Text
baseURL :: Text
baseURL, Values
overrides :: Gemlog -> Values
overrides :: Values
overrides}) String
path = do
    let (Template
feed, Template
entry) = (Gemlog -> (Template, Template))
-> (Gemlog -> (Template, Template))
-> Bool
-> Gemlog
-> (Template, Template)
forall a. a -> a -> Bool -> a
bool Gemlog -> (Template, Template)
atomTemplates Gemlog -> (Template, Template)
gemfeedTemplates Bool
gemfeed Gemlog
glog
        ending :: Text
ending = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"" Text
"\CR" Bool
gemfeed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\LF"
        fname :: String
fname = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"atom.xml" String
"index.gmi" Bool
gemfeed
    String
output <- String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
path (String
path String -> ShowS
</> String
fname) (Bool -> String) -> IO Bool -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesDirectoryExist String
path
    [Values]
posts <- [Values] -> [Values]
sortPosts ([Values] -> [Values]) -> IO [Values] -> IO [Values]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gemlog -> IO [Values]
parsePosts Gemlog
glog
    String -> Text -> IO ()
TIO.writeFile String
output
        (Text -> IO ())
-> ([(Text, Text)] -> Text) -> [(Text, Text)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text -> Text) -> Bool -> Text -> Text
forall a. a -> a -> Bool -> a
bool Text -> Text
forall a. a -> a
id Text -> Text
crlf Bool
gemfeed
        (Text -> Text)
-> ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Values -> Text
format Template
feed
        (Values -> Text)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Values -> Values
escapeFeed Bool
gemfeed
        (Values -> Values)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Values
overrides Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<>)
        (Values -> Values)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Values] -> Values
lastModified [Values]
posts Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<>)
        (Values -> Values)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList
        ([(Text, Text)] -> IO ()) -> [(Text, Text)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [ (Text
"title", Text
title)
          , (Text
"author", Text
author)
          , (Text
"base", Text
baseURL)
          , (Text
"url", (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
baseURL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ShowS
takeFileName String
output))
          ,
              ( Text
"entries"
              , Text -> [Text] -> Text
T.intercalate Text
ending ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                    (Values -> Text) -> [Values] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.stripEnd (Text -> Text) -> (Values -> Text) -> Values -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text -> Text) -> Bool -> Text -> Text
forall a. a -> a -> Bool -> a
bool Text -> Text
forall a. a -> a
id Text -> Text
crlf Bool
gemfeed (Text -> Text) -> (Values -> Text) -> Values -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Values -> Text
format Template
entry (Values -> Text) -> (Values -> Values) -> Values -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Values -> Values
escapeFeed Bool
gemfeed) [Values]
posts
              )
          ]

-- Parse all the posts /recursively/ in a `Gemlog's source directory.
-- Adds the @url@, @gemlog@, and @author@ fields.
parsePosts :: Gemlog -> IO [Values]
parsePosts :: Gemlog -> IO [Values]
parsePosts (Gemlog{Text
title :: Gemlog -> Text
title :: Text
title, Text
author :: Gemlog -> Text
author :: Text
author, String
sourceDir :: Gemlog -> String
sourceDir :: String
sourceDir, Text
baseURL :: Gemlog -> Text
baseURL :: Text
baseURL, Values
overrides :: Gemlog -> Values
overrides :: Values
overrides}) =
    (Values -> Values) -> [Values] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map (\Values
p -> Text -> Text -> Values
forall k v. Hashable k => k -> v -> HashMap k v
singleton Text
"url" ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
baseURL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Values -> String
fileName Values
p)) Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Values
p)
        ([Values] -> [Values]) -> IO [Values] -> IO [Values]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (String -> IO Values) -> [String] -> IO [Values]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Values -> String -> IO Values
readPost ([(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList [(Text
"gemlog", Text
title), (Text
"author", Text
author)] Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Values
overrides))
                ([String] -> IO [Values])
-> ([String] -> [String]) -> [String] -> IO [Values]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gmi") (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension)
                ([String] -> IO [Values]) -> IO [String] -> IO [Values]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO [String]
listFilesRecursive String
sourceDir
            )

-- Take the file name from the path in a parsed post.
fileName :: Values -> FilePath
fileName :: Values -> String
fileName Values
p = ShowS
takeFileName ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Values -> Text
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
findWithDefault Text
"post.gmi" Text
"path" Values
p

-- Make the newlines CRLF in the given text if the boolean is @True@.
crlf :: Text -> Text
crlf :: Text -> Text
crlf = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\CR") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\CR')) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines