{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Hakyll.Convert.OutputFormat (validOutputFormat, formatPath) where

import Data.Default
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Time.Format (defaultTimeLocale, formatTime)
import Hakyll.Convert.Common
import System.FilePath

validOutputFormat :: T.Text -> Bool
validOutputFormat :: Text -> Bool
validOutputFormat Text
format
  | Text -> Bool
T.null Text
format = Bool
False
  | Bool
otherwise =
    case Text -> DistilledPost -> Maybe Text
formatPath Text
format DistilledPost
forall a. Default a => a
def of
      Just Text
_ -> Bool
True
      Maybe Text
Nothing -> Bool
False

formatPath :: T.Text -> DistilledPost -> Maybe T.Text
formatPath :: Text -> DistilledPost -> Maybe Text
formatPath Text
format DistilledPost
post = [Text] -> Text
T.concat ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Text -> Maybe [Text]
helper [] Text
format
  where
    helper :: [Text] -> Text -> Maybe [Text]
helper [Text]
acc Text
input =
      case Text -> Maybe (Char, Text)
T.uncons Text
input of
        Just (Char
'%', Text
rest) ->
          case Text -> Maybe (Char, Text)
T.uncons Text
rest of
            Just (Char
ch, Text
rest2) ->
              if Char
ch Char -> Map Char (DistilledPost -> Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map Char (DistilledPost -> Text)
acceptableFormats
                then
                  let formatter :: DistilledPost -> Text
formatter = Map Char (DistilledPost -> Text)
acceptableFormats Map Char (DistilledPost -> Text) -> Char -> DistilledPost -> Text
forall k a. Ord k => Map k a -> k -> a
M.! Char
ch
                   in [Text] -> Text -> Maybe [Text]
helper ((DistilledPost -> Text
formatter DistilledPost
post) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) Text
rest2
                else Maybe [Text]
forall a. Maybe a
Nothing
            Maybe (Char, Text)
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing
        Just (Char
ch, Text
rest) -> [Text] -> Text -> Maybe [Text]
helper ((Char -> Text
T.singleton Char
ch) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) Text
rest
        Maybe (Char, Text)
Nothing -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc

-- When adding a new format, don't forget to update the help message in
-- tools/hakyll-convert.hs
acceptableFormats :: M.Map Char (DistilledPost -> T.Text)
acceptableFormats :: Map Char (DistilledPost -> Text)
acceptableFormats =
  [(Char, DistilledPost -> Text)] -> Map Char (DistilledPost -> Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ -- this lets users put literal percent sign in the format)
      (Char
'%', Text -> DistilledPost -> Text
forall a b. a -> b -> a
const (Text -> DistilledPost -> Text) -> Text -> DistilledPost -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
'%'),
      (Char
'o', DistilledPost -> Text
fmtOriginalPath), -- original filepath, like 2016/01/02/blog-post.html
      (Char
's', DistilledPost -> Text
fmtSlug), -- original slug, i.e. "blog-post" from the example above
      (Char
'y', DistilledPost -> Text
fmtYear2), -- publication year, 2 digits
      (Char
'Y', DistilledPost -> Text
fmtYear4), -- publication year, 4 digits
      (Char
'm', DistilledPost -> Text
fmtMonth), -- publication month
      (Char
'd', DistilledPost -> Text
fmtDay), -- publication day
      (Char
'H', DistilledPost -> Text
fmtHour), -- publication hour
      (Char
'M', DistilledPost -> Text
fmtMinute), -- publication minute
      (Char
'S', DistilledPost -> Text
fmtSecond) -- publication second
    ]

fmtOriginalPath :: DistilledPost -> T.Text
fmtOriginalPath :: DistilledPost -> Text
fmtOriginalPath DistilledPost
post =
  String -> Text
T.pack
    (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropTrailingSlash
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtensions
    (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
chopUri (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (DistilledPost -> Text
dpUri DistilledPost
post)
  where
    dropTrailingSlash :: String -> String
dropTrailingSlash = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
    dropDomain :: String -> String
dropDomain String
path =
      -- carelessly assumes we can treat URIs like filepaths
      [String] -> String
joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ -- drop the domain
          String -> [String]
splitPath String
path
    chopUri :: String -> String
chopUri (String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
dropPrefix String
"http://" -> (String
"", String
rest)) = String -> String
dropDomain String
rest
    chopUri (String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
dropPrefix String
"https://" -> (String
"", String
rest)) = String -> String
dropDomain String
rest
    chopUri String
u =
      String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"We've wrongly assumed that blog post URIs start with http:// or https://, but we got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
u

    dropPrefix :: Eq a => [a] -> [a] -> ([a], [a])
    dropPrefix :: [a] -> [a] -> ([a], [a])
dropPrefix (a
x : [a]
xs) (a
y : [a]
ys) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
dropPrefix [a]
xs [a]
ys
    dropPrefix [a]
left [a]
right = ([a]
left, [a]
right)

fmtSlug :: DistilledPost -> T.Text
fmtSlug :: DistilledPost -> Text
fmtSlug DistilledPost
post =
  Text -> Text
T.reverse
    (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'))
    (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse
    (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DistilledPost -> Text
fmtOriginalPath DistilledPost
post

fmtDate :: String -> DistilledPost -> T.Text
fmtDate :: String -> DistilledPost -> Text
fmtDate String
format = String -> Text
T.pack (String -> Text)
-> (DistilledPost -> String) -> DistilledPost -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
format) (UTCTime -> String)
-> (DistilledPost -> UTCTime) -> DistilledPost -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistilledPost -> UTCTime
dpDate

fmtYear2 :: DistilledPost -> T.Text
fmtYear2 :: DistilledPost -> Text
fmtYear2 = String -> DistilledPost -> Text
fmtDate String
"%y"

fmtYear4 :: DistilledPost -> T.Text
fmtYear4 :: DistilledPost -> Text
fmtYear4 = String -> DistilledPost -> Text
fmtDate String
"%Y"

fmtMonth :: DistilledPost -> T.Text
fmtMonth :: DistilledPost -> Text
fmtMonth = String -> DistilledPost -> Text
fmtDate String
"%m"

fmtDay :: DistilledPost -> T.Text
fmtDay :: DistilledPost -> Text
fmtDay = String -> DistilledPost -> Text
fmtDate String
"%d"

fmtHour :: DistilledPost -> T.Text
fmtHour :: DistilledPost -> Text
fmtHour = String -> DistilledPost -> Text
fmtDate String
"%H"

fmtMinute :: DistilledPost -> T.Text
fmtMinute :: DistilledPost -> Text
fmtMinute = String -> DistilledPost -> Text
fmtDate String
"%M"

fmtSecond :: DistilledPost -> T.Text
fmtSecond :: DistilledPost -> Text
fmtSecond = String -> DistilledPost -> Text
fmtDate String
"%S"