{-| Dictionary functions.

-}
module Shikensu.Contrib
    ( clearMetadata
    , clearMetadataDef
    , clone
    , copyPropsToMetadata
    , copyPropsToMetadataDef
    , exclude
    , insertMetadata
    , insertMetadataDef
    , permalink
    , permalinkDef
    , prefixDirname
    , prefixDirnameDef
    , rename
    , renameDef
    , renameExt
    , renameExtDef
    , renderContent
    , renderContentDef
    , replaceMetadata
    , replaceMetadataDef
    , setContent
    , setContentDef
    , transformContent
    , transformContentDef
    ) where

import Data.ByteString (ByteString)
import Data.Monoid ((<>))
import Shikensu (forkDefinition)
import Shikensu.Internal.Types
import Shikensu.Internal.Utilities (compileParentPath, compilePathToRoot)
import Shikensu.Metadata (transposeToMetadata)
import System.FilePath (FilePath, combine)

import qualified Data.Aeson.KeyMap as KeyMap (empty, union)


{-| Clear metadata.

Replace the current hash map with an empty one.
-}
clearMetadata :: Dictionary -> Dictionary
clearMetadata :: Dictionary -> Dictionary
clearMetadata =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Definition -> Definition
clearMetadataDef


clearMetadataDef :: Definition -> Definition
clearMetadataDef :: Definition -> Definition
clearMetadataDef Definition
def =
    Definition
def { $sel:metadata:Definition :: Metadata
metadata = Metadata
forall v. KeyMap v
KeyMap.empty }



{-| Clone.

For each definition that has the given `localPath` (1st argument),
make a clone with a new `localPath` (2nd argument),
and add that into dictionary just after the matching definition.

> clone "index.html" "200.html" dictionary
-}
clone :: FilePath -> FilePath -> Dictionary -> Dictionary
clone :: FilePath -> FilePath -> Dictionary -> Dictionary
clone FilePath
existingPath FilePath
newPath Dictionary
dict =
    let
        makeNew :: Definition -> Dictionary -> Dictionary
makeNew = \Definition
def Dictionary
acc ->
            if Definition -> FilePath
localPath Definition
def FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
existingPath
               then Dictionary
acc Dictionary -> Dictionary -> Dictionary
forall a. Semigroup a => a -> a -> a
<> [FilePath -> Definition -> Definition
forkDefinition FilePath
newPath Definition
def]
               else Dictionary
acc
    in
        Dictionary
dict Dictionary -> Dictionary -> Dictionary
forall a. Semigroup a => a -> a -> a
<> (Definition -> Dictionary -> Dictionary)
-> Dictionary -> Dictionary -> Dictionary
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> Dictionary -> Dictionary
makeNew [] Dictionary
dict



{-| Copy definition properties into the metadata.

See the `toJSON` implementation for `Definition` in `Shikensu.Types`
to see what properties get put in here.
-}
copyPropsToMetadata :: Dictionary -> Dictionary
copyPropsToMetadata :: Dictionary -> Dictionary
copyPropsToMetadata =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Definition -> Definition
copyPropsToMetadataDef


copyPropsToMetadataDef :: Definition -> Definition
copyPropsToMetadataDef :: Definition -> Definition
copyPropsToMetadataDef Definition
def =
    Definition
def
        { $sel:metadata:Definition :: Metadata
metadata = Metadata -> Metadata -> Metadata
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union (Definition -> Metadata
forall a. ToJSON a => a -> Metadata
transposeToMetadata Definition
def) (Definition -> Metadata
metadata Definition
def) }



{-| Exclude.

Filter out the definitions that have the given `localPath`.
-}
exclude :: FilePath -> Dictionary -> Dictionary
exclude :: FilePath -> Dictionary -> Dictionary
exclude FilePath
path =
    (Definition -> Bool) -> Dictionary -> Dictionary
forall a. (a -> Bool) -> [a] -> [a]
filter (\Definition
def -> Definition -> FilePath
localPath Definition
def FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
path)



{-| Insert metadata.

Merge the current hash map with another one.
-}
insertMetadata :: Metadata -> Dictionary -> Dictionary
insertMetadata :: Metadata -> Dictionary -> Dictionary
insertMetadata Metadata
a =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Metadata -> Definition -> Definition
insertMetadataDef Metadata
a)


insertMetadataDef :: Metadata -> Definition -> Definition
insertMetadataDef :: Metadata -> Definition -> Definition
insertMetadataDef Metadata
given Definition
def =
    Definition
def { $sel:metadata:Definition :: Metadata
metadata = Metadata -> Metadata -> Metadata
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union Metadata
given (Definition -> Metadata
metadata Definition
def) }



{-| Permalink.

Append the basename to the dirname,
and change the basename to the given string.
It will NOT change definitions that already have the new basename.

> permalink "index" dictionary
-}
permalink :: String -> Dictionary -> Dictionary
permalink :: FilePath -> Dictionary -> Dictionary
permalink FilePath
a =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Definition -> Definition
permalinkDef FilePath
a)


permalinkDef :: String -> Definition -> Definition
permalinkDef :: FilePath -> Definition -> Definition
permalinkDef FilePath
newBasename Definition
def =
    if Definition -> FilePath
basename Definition
def FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
newBasename then
       let
           newDirname :: FilePath
newDirname = FilePath -> FilePath -> FilePath
combine (Definition -> FilePath
dirname Definition
def) (Definition -> FilePath
basename Definition
def)
       in
           Definition
def
               { $sel:basename:Definition :: FilePath
basename    = FilePath
newBasename
               , $sel:dirname:Definition :: FilePath
dirname     = FilePath
newDirname
               , $sel:parentPath:Definition :: Maybe FilePath
parentPath  = FilePath -> Maybe FilePath
compileParentPath FilePath
newDirname
               , $sel:pathToRoot:Definition :: FilePath
pathToRoot  = FilePath -> FilePath
compilePathToRoot FilePath
newDirname
               }
    else
        Definition
def



{-| Prefix dirname.

Prefix the dirname of each definition with a given string.
-}
prefixDirname :: String -> Dictionary -> Dictionary
prefixDirname :: FilePath -> Dictionary -> Dictionary
prefixDirname FilePath
prefix = (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Definition -> Definition
prefixDirnameDef FilePath
prefix)


prefixDirnameDef :: String -> Definition -> Definition
prefixDirnameDef :: FilePath -> Definition -> Definition
prefixDirnameDef FilePath
prefix Definition
def =
    let
        newDirname :: FilePath
newDirname = FilePath
prefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Definition -> FilePath
dirname Definition
def
    in
        Definition
def
            { $sel:dirname:Definition :: FilePath
dirname     = FilePath
newDirname
            , $sel:parentPath:Definition :: Maybe FilePath
parentPath  = FilePath -> Maybe FilePath
compileParentPath FilePath
newDirname
            , $sel:pathToRoot:Definition :: FilePath
pathToRoot  = FilePath -> FilePath
compilePathToRoot FilePath
newDirname
            }



{-| Rename.

Change the `localPath` of the definitions that match a given `localPath`.
For example, if you have a definition with the local path `a/b/example.html`:

> rename "a/b/example.html" "example/index.html" dictionary

See `Shikensu.localPath` for more info.
-}
rename :: FilePath -> FilePath -> Dictionary -> Dictionary
rename :: FilePath -> FilePath -> Dictionary -> Dictionary
rename FilePath
a FilePath
b = (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> Definition -> Definition
renameDef FilePath
a FilePath
b)


renameDef :: FilePath -> FilePath -> Definition -> Definition
renameDef :: FilePath -> FilePath -> Definition -> Definition
renameDef FilePath
oldPath FilePath
newPath Definition
def =
  if Definition -> FilePath
localPath Definition
def FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
oldPath
     then FilePath -> Definition -> Definition
forkDefinition FilePath
newPath Definition
def
     else Definition
def



{-| Rename extension.

Example:

> renameExt ".markdown" ".html" dictionary
> -- The definitions that had the extname ".markdown"
> -- now have the extname ".html"
-}
renameExt :: String -> String -> Dictionary -> Dictionary
renameExt :: FilePath -> FilePath -> Dictionary -> Dictionary
renameExt FilePath
a FilePath
b =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> Definition -> Definition
renameExtDef FilePath
a FilePath
b)


renameExtDef :: String -> String -> Definition -> Definition
renameExtDef :: FilePath -> FilePath -> Definition -> Definition
renameExtDef FilePath
oldExtname FilePath
newExtname Definition
def =
    if Definition -> FilePath
extname Definition
def FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
oldExtname
        then Definition
def { $sel:extname:Definition :: FilePath
extname = FilePath
newExtname }
        else Definition
def



{-| Render content.

Replace the content property by providing a renderer.
A renderer is a function with the signature `Definition -> Maybe ByteString`.

You can use this to render templates, markdown, etc.
-}
renderContent :: (Definition -> Maybe ByteString) -> Dictionary -> Dictionary
renderContent :: (Definition -> Maybe ByteString) -> Dictionary -> Dictionary
renderContent Definition -> Maybe ByteString
a =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Definition -> Maybe ByteString) -> Definition -> Definition
renderContentDef Definition -> Maybe ByteString
a)


renderContentDef :: (Definition -> Maybe ByteString) -> Definition -> Definition
renderContentDef :: (Definition -> Maybe ByteString) -> Definition -> Definition
renderContentDef Definition -> Maybe ByteString
renderer Definition
def =
    Definition
def { $sel:content:Definition :: Maybe ByteString
content = Definition -> Maybe ByteString
renderer Definition
def }



{-| Replace metadata.

Replace the current hash map with another one.
-}
replaceMetadata :: Metadata -> Dictionary -> Dictionary
replaceMetadata :: Metadata -> Dictionary -> Dictionary
replaceMetadata Metadata
a =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Metadata -> Definition -> Definition
replaceMetadataDef Metadata
a)


replaceMetadataDef :: Metadata -> Definition -> Definition
replaceMetadataDef :: Metadata -> Definition -> Definition
replaceMetadataDef Metadata
given Definition
def =
    Definition
def { $sel:metadata:Definition :: Metadata
metadata = Metadata
given }


{-| Set content.

Set content directly.
-}
setContent :: ByteString -> Dictionary -> Dictionary
setContent :: ByteString -> Dictionary -> Dictionary
setContent ByteString
content =
    (Definition -> Definition) -> Dictionary -> Dictionary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Definition -> Definition
setContentDef ByteString
content)


setContentDef :: ByteString -> Definition -> Definition
setContentDef :: ByteString -> Definition -> Definition
setContentDef ByteString
content Definition
def =
    Definition
def { $sel:content:Definition :: Maybe ByteString
content = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
content }


{-| Transform content.

Alias for `renderContent`.
-}
transformContent :: (Definition -> Maybe ByteString) -> Dictionary -> Dictionary
transformContent :: (Definition -> Maybe ByteString) -> Dictionary -> Dictionary
transformContent = (Definition -> Maybe ByteString) -> Dictionary -> Dictionary
renderContent


transformContentDef :: (Definition -> Maybe ByteString) -> Definition -> Definition
transformContentDef :: (Definition -> Maybe ByteString) -> Definition -> Definition
transformContentDef =
    (Definition -> Maybe ByteString) -> Definition -> Definition
renderContentDef