module Development.Shake.Man ( manpagesA
                             , manpagesR
                             , manpages
                             ) where

import           Development.Shake
import           Development.Shake.FilePath

manpagesA :: FilePath -- ^ Source file. Can be any format accepted by [pandoc](http://hackage.haskell.org/package/pandoc).
          -> FilePath -- ^ Output file.
          -> Action ()
manpagesA :: FilePath -> FilePath -> Action ()
manpagesA FilePath
source FilePath
out =
    Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [ FilePath
source ] Action () -> Action () -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    [FilePath] -> Action ()
forall args r. (Partial, CmdArguments args) => args
cmd [FilePath
"pandoc", FilePath
source, FilePath
"-s", FilePath
"-t", FilePath
"man", FilePath
"-o", FilePath
out]

manpagesR :: FilePath -- ^ Source file
          -> FilePattern -- ^ Output file pattern
          -> Rules ()
manpagesR :: FilePath -> FilePath -> Rules ()
manpagesR FilePath
source FilePath
pat =
    FilePath
pat Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out -> FilePath -> FilePath -> Action ()
manpagesA FilePath
source FilePath
out

-- | Rules for converting markdown source to manpages.
manpages :: Rules ()
manpages :: Rules ()
manpages =
    FilePath
"//*.1" Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out ->
        let source :: FilePath
source = FilePath
out FilePath -> FilePath -> FilePath
-<.> FilePath
"md" in
            FilePath -> FilePath -> Action ()
manpagesA FilePath
source FilePath
out