{-# language OverloadedStrings #-}
module SitePipe.Utilities
  ( addPrefix
  , setExt
  , getTags
  ) where

import System.FilePath.Posix
import Data.Aeson
import Data.Aeson.Lens
import qualified Data.Map as M
import qualified Data.Text as T
import Control.Lens hiding ((.=))

-- | Set the extension of a filepath or url to the given extension.
-- Use @setExt ""@ to remove any extension.
setExt :: String -> FilePath -> FilePath
setExt :: String -> String -> String
setExt = (String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
replaceExtension

-- | Add a prefix to a filepath or url
addPrefix :: String -> FilePath -> FilePath
addPrefix :: String -> String -> String
addPrefix = String -> String -> String
forall a. [a] -> [a] -> [a]
(++)

-- | Given a function which creates a url from a tag name and a list of posts
-- (which have a tags property which is a list of strings)
-- this returns a list of tags which contain:
--
-- * name: The tag name
-- * url: The tag's url
-- * posts: The list of posts matching that tag
getTags :: (String -> String) -- ^ Accept a tagname and create a url
           -> [Value] -- ^ List of posts
           -> [Value]
getTags :: (String -> String) -> [Value] -> [Value]
getTags String -> String
makeUrl [Value]
postList = (String -> [Value] -> Value) -> (String, [Value]) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String) -> String -> [Value] -> Value
makeTag String -> String
makeUrl) ((String, [Value]) -> Value) -> [(String, [Value])] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String [Value] -> [(String, [Value])]
forall k a. Map k a -> [(k, a)]
M.toList Map String [Value]
tagMap
  where
    tagMap :: Map String [Value]
tagMap = ([Value] -> [Value] -> [Value])
-> [Map String [Value]] -> Map String [Value]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Value] -> [Value] -> [Value]
forall a. Monoid a => a -> a -> a
mappend (Value -> Map String [Value]
forall a. AsValue a => a -> Map String [a]
toMap (Value -> Map String [Value]) -> [Value] -> [Map String [Value]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
postList)
    toMap :: a -> Map String [a]
toMap a
post = [(String, [a])] -> Map String [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([String] -> [[a]] -> [(String, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip (a
post a -> Getting (Endo [String]) a String -> [String]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' a Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"tags" ((Value -> Const (Endo [String]) Value)
 -> a -> Const (Endo [String]) a)
-> ((String -> Const (Endo [String]) String)
    -> Value -> Const (Endo [String]) Value)
-> Getting (Endo [String]) a String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [String]) Value)
-> Value -> Const (Endo [String]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [String]) Value)
 -> Value -> Const (Endo [String]) Value)
-> ((String -> Const (Endo [String]) String)
    -> Value -> Const (Endo [String]) Value)
-> (String -> Const (Endo [String]) String)
-> Value
-> Const (Endo [String]) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [String]) Text)
-> Value -> Const (Endo [String]) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (Endo [String]) Text)
 -> Value -> Const (Endo [String]) Value)
-> ((String -> Const (Endo [String]) String)
    -> Text -> Const (Endo [String]) Text)
-> (String -> Const (Endo [String]) String)
-> Value
-> Const (Endo [String]) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String)
-> (String -> Const (Endo [String]) String)
-> Text
-> Const (Endo [String]) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> String
T.unpack) ([[a]] -> [(String, [a])]) -> [[a]] -> [(String, [a])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. a -> [a]
repeat [a
post])

-- | Makes a single tag
makeTag :: (String -> String) -> String -> [Value] -> Value
makeTag :: (String -> String) -> String -> [Value] -> Value
makeTag String -> String
makeUrl String
tagname [Value]
posts = [Pair] -> Value
object
  [ Text
"tag" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
tagname
  , Text
"url" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> String
makeUrl String
tagname
  , Text
"posts" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Value]
posts
  ]