diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Chris Penner (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Chris Penner nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# sitepipe diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,65 @@ +{-# language OverloadedStrings #-} +{-# language DuplicateRecordFields #-} +module Main where + +import SitePipe +import qualified Data.Map as M +import Data.Text.Lens +import qualified Data.Text as T +import qualified Text.Mustache as MT +import qualified Text.Mustache.Types as MT + +main :: IO () +main = siteWithGlobals funcs $ do + posts <- fmap processPostTags <$> resourceLoader markdownReader ["posts/*.md"] + let tags = byTags posts + writeTemplate "templates/index.html" [mkIndexEnv posts tags] + writeTemplate "templates/base.html" (over (key "tags" . _Array . traverse) stripHTMLSuffix <$> posts) + writeTemplate "templates/tag.html" (stripPostsHTMLSuffix <$> tags) + staticAssets + +funcs :: MT.Value +funcs = MT.object + ["truncate" MT.~> MT.overText (T.take 30) + ] + +stripHTMLSuffix :: Value -> Value +stripHTMLSuffix obj = obj + & key "url" . _String . unpacked %~ setExt "" + +stripPostsHTMLSuffix :: Value -> Value +stripPostsHTMLSuffix tag = tag + & key "posts" . _Array . traversed . key "url" . _String . unpacked %~ setExt "" + +mkIndexEnv :: [Value] -> [Value] -> Value +mkIndexEnv posts tags = + object [ "posts" .= (stripHTMLSuffix <$> posts) + , "tags" .= (stripHTMLSuffix <$> tags) + , "url" .= ("/index.html" :: String) + ] + +staticAssets :: SiteM () +staticAssets = copyFiles + [ "css/*.css" + , "js/" + , "images/" + ] + +processPostTags :: Value -> Value +processPostTags post = post & key "tags" . _Array . traverse %~ mkSimpleTag + where + mkSimpleTag (String t) = makeTag (T.unpack t, []) + mkSimpleTag x = x + +byTags :: [Value] -> [Value] +byTags postList = makeTag <$> M.toList tagMap + where + tagMap = M.unionsWith mappend (fmap toMap postList) + toMap post = M.fromList (zip (post ^.. key "tags" . values . key "tag" . _String . unpacked) $ repeat [post]) + +makeTag :: (String, [Value]) -> Value +makeTag (tagname, posts) = object + [ "tag" .= tagname + , "url" .= ("/tag/" ++ tagname ++ ".html") + , "posts" .= posts + ] diff --git a/sitepipe.cabal b/sitepipe.cabal new file mode 100644 --- /dev/null +++ b/sitepipe.cabal @@ -0,0 +1,75 @@ +name: sitepipe +version: 0.1.0 +synopsis: A simple to understand static site generator +description: A simple to understand static site generator +homepage: https://github.com/ChrisPenner/sitepipe#readme +license: BSD3 +license-file: LICENSE +author: Chris Penner +maintainer: christopher.penner@gmail.com +copyright: 2017 Chris Penner +category: Web +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: SitePipe + , SitePipe.Pipes + , SitePipe.Readers + , SitePipe.Templating + , SitePipe.Files + , SitePipe.Parse + , SitePipe.Types + , SitePipe.Utilities + build-depends: base >= 4.7 && < 5 + , optparse-applicative + , unordered-containers + , containers + , directory + , filepath + , megaparsec + , mtl + , optparse-generic + , pandoc + , yaml + , mustache >= 2.2.2 + , bytestring + , text + , parsec + , exceptions + , Glob + , lens-aeson + , lens + , aeson + , shelly + , MissingH + + default-language: Haskell2010 + +executable sitepipe-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , sitepipe + , lens + , containers + , text + , unordered-containers + , mustache >= 2.2.3 + default-language: Haskell2010 + +test-suite sitepipe-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , sitepipe + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/ChrisPenner/sitepipe diff --git a/src/SitePipe.hs b/src/SitePipe.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe.hs @@ -0,0 +1,55 @@ +module SitePipe + ( + -- * SitePipe + + -- | This module re-exports everything you need to build a site. + -- In addition to exporting all of SitePipe it also exports "Data.Aeson", "Data.Aeson.Lens", + -- "Control.Lens", "System.FilePath.Posix", and 'liftIO' + + -- * Running SitePipe + site + , siteWithGlobals + + -- * Loaders + , resourceLoader + + -- * Writers + , writeWith + , writeTemplate + , textWriter + + -- * Loader/Writers + , copyFiles + , copyFilesWith + + -- * Readers + -- ** Built-in + , markdownReader + , textReader + + -- ** Reader Generators + , mkPandocReader + + -- * Utilities + , setExt + , addPrefix + + -- * Types + , module SitePipe.Types + + -- * Exports + , module X + , liftIO + ) where + +import SitePipe.Types +import SitePipe.Files +import SitePipe.Pipes +import SitePipe.Readers +import SitePipe.Utilities +import Data.Aeson.Lens as X +import Data.Aeson as X +import Control.Lens as X hiding ((.=), (<.>)) +import System.FilePath.Posix as X + +import Control.Monad.IO.Class (liftIO) diff --git a/src/SitePipe/Files.hs b/src/SitePipe/Files.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Files.hs @@ -0,0 +1,152 @@ +{-# language ViewPatterns #-} +{-# language RankNTypes #-} +{-# language RecordWildCards #-} +{-# language NamedFieldPuns #-} +{-# language OverloadedStrings #-} +module SitePipe.Files + ( + -- * Loaders + resourceLoader + + -- * Writers + , writeWith + , writeTemplate + , textWriter + + -- * Loader/Writers + , copyFiles + , copyFilesWith + ) where + +import Data.String +import Control.Monad.Catch +import Data.Foldable +import SitePipe.Templating +import SitePipe.Types +import qualified System.FilePath.Glob as G +import Data.Aeson +import Data.Aeson.Lens +import Data.Aeson.Types +import Control.Lens +import Text.Mustache +import System.Directory +import System.FilePath.Posix +import Control.Monad.Reader +import qualified Data.Text as T +import Data.Text.Lens +import SitePipe.Parse +import SitePipe.Utilities +import Shelly hiding ((), FilePath, relPath) +import Data.String.Utils +import Data.Bool + +-- | Given a filepath globbing pattern relative to your sources root +-- this returns a list of absolute filepaths of matching files. +-- Standard globbing rules apply. +-- +-- * "posts/*.md": matches any markdown files in the posts directory of your source folder. +-- * "**/*.txt": matches all text files recursively in your source folder. +srcGlob :: GlobPattern -> SiteM [FilePath] +srcGlob pattern@('/':_) = throwM $ SitePipeError ("glob pattern " ++ pattern ++ " must be a relative path") +srcGlob pattern = do + srcD <- asks srcDir + liftIO $ G.glob (srcD pattern) + +-- | Loads a Mustache template given a relative filepath. +loadTemplate :: FilePath -> SiteM Template +loadTemplate filePath = do + srcD <- asks srcDir + mTemplate <- liftIO $ automaticCompile [srcD] filePath + case mTemplate of + Left err -> throwM $ TemplateParseErr err + Right template -> return template + +-- | Given a path to a mustache template file (relative to your source directory); +-- this writes a list of resources to the output directory by applying each one to the template. +writeTemplate :: (ToJSON a) => FilePath -> [a] -> SiteM () +writeTemplate templatePath resources = do + template <- loadTemplate templatePath + writeWith (renderTemplate template) resources + +-- | Write a list of resources using the given processing function from a resource +-- to a string. +writeWith :: (ToJSON a) => (a -> SiteM String) -> [a] -> SiteM () +writeWith resourceRenderer resources = + traverse_ (writeOneWith resourceRenderer) resources + +-- | Write a single resource to file using the given processing function. +writeOneWith :: (ToJSON a) => (a -> SiteM String) -> a -> SiteM () +writeOneWith renderer obj = do + outD <- asks outputDir + renderedContent <- renderer obj + let outFile = outD (toJSON obj ^. key "url" . _String . unpacked . to (dropWhile (== '/'))) + liftIO . createDirectoryIfMissing True $ takeDirectory outFile + liftIO . putStrLn $ "Writing " ++ outFile + liftIO $ writeFile outFile renderedContent + +-- | Writes the content of the given resources without using a template. +textWriter :: (ToJSON a) => [a] -> SiteM () +textWriter resources = + writeWith (return . view (key "content" . _String . unpacked) . toJSON) resources + +-- | Given a list of file or directory globs (see 'srcGlob') +-- we copy matching files and directories as-is from the source directory +-- to the output directory maintaining their relative filepath. +copyFiles :: [GlobPattern] -> SiteM () +copyFiles = copyFilesWith id + +-- | Runs 'copyFiles' but using a filepath transforming function to determine +-- the output filepath. The filepath transformation accepts and should return +-- a relative path. +copyFilesWith :: (FilePath -> FilePath) -> [GlobPattern] -> SiteM () +copyFilesWith transformPath patterns = do + Settings{..} <- ask + srcFilenames <- concat <$> traverse srcGlob patterns + let destFilenames = (outputDir ) . transformPath . makeRelative srcDir <$> srcFilenames + shelly $ do + let getDir pth = bool (takeDirectory) (takeDirectory . takeDirectory) (endswith "/" pth) $ pth + traverse_ (mkdir_p . fromString . getDir) destFilenames + traverse_ copy (zip srcFilenames destFilenames) + where + copy (src, dest) = do + echo $ T.concat ["Copying ", T.pack src, " to ", T.pack dest] + cp_r (fromString src) (fromString dest) + +-- | Given a resource reader (see "SitePipe.Readers") +-- this function finds all files matching any of the provided list +-- of fileglobs (according to 'srcGlob') and returns a list of loaded resources +-- as Aeson 'Value's. +resourceLoader :: (String -> IO String) -> [GlobPattern] -> SiteM [Value] +resourceLoader = resourceLoaderGen + +-- | A more generic version of 'resourceLoader' which returns any type with a +-- 'FromJSON' instance. It also handles and displays any conversion errors. +resourceLoaderGen :: (FromJSON a) => (String -> IO String) -> [GlobPattern] -> SiteM [a] +resourceLoaderGen fileReader patterns = do + filenames <- concat <$> traverse srcGlob patterns + traverse (loadWith fileReader) filenames + +-- | loads a file from filepath and applies a given filreader. +loadWith :: (FromJSON a) => (String -> IO String) -> FilePath -> SiteM a +loadWith fileReader filepath = do + Settings{srcDir} <- ask + let relPath = makeRelative srcDir filepath + file <- liftIO $ readFile filepath + (meta, source) <- processSource filepath file + content <- liftIO $ fileReader source + valueToResource (addMeta relPath content meta) + where + addMeta relPath content meta = + meta + & _Object . at "filepath" ?~ String (T.pack relPath) + & _Object . at "content" ?~ String (T.pack content) + & _Object . at "url" ?~ (String . T.pack . setExt "html" $ ("/" relPath)) + +-- | Converts a 'Value' to a generic resource implementing 'FromJSON', handling any errors. +valueToResource :: (MonadThrow m, FromJSON a) => Value -> m a +valueToResource obj = + case parseEither parseJSON obj of + Left err -> throwM (JSONErr name err) + Right result -> return result + where + name = obj ^. key "filepath" . _String . unpacked diff --git a/src/SitePipe/Parse.hs b/src/SitePipe/Parse.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Parse.hs @@ -0,0 +1,56 @@ +module SitePipe.Parse + ( processSource + ) where + +import Control.Monad.Catch hiding (try) +import Text.Megaparsec +import Text.Megaparsec.String +import Data.Aeson +import qualified Data.HashMap.Lazy as HM +import Data.Yaml hiding (Parser) +import SitePipe.Types +import Data.ByteString.Char8 (pack) +import Data.Maybe + +-- | Parses yaml block from the file if it exists, returning the inner yaml block and the remaining file contents +resourceP :: Parser (String, String) +resourceP = do + yaml <- fromMaybe "" <$> optional yamlParser + space + rest <- manyTill anyChar eof + return (yaml, rest) + +-- | Given an identifier and file contents runs the yaml parser and returns +-- the contents of the yaml block and the remaining file contents; handling +-- any errors. +splitMeta :: MonadThrow m => String -> String -> m (String, String) +splitMeta ident str = + case parse resourceP ident str of + Left err -> throwM (MParseErr err) + Right res -> return res + +-- | Parses a yaml metadata block, returning the string which contains the yaml. +yamlParser :: Parser String +yamlParser = do + _ <- yamlSep + manyTill anyChar (try (eol >> yamlSep)) + where + yamlSep = string "---" >> eol + +-- | Decodes a yaml metadata block into an Aeson object containing the data in the yaml. +decodeMeta :: MonadThrow m => String -> String -> m Value +decodeMeta ident metaBlock = + case decodeEither (pack metaBlock) of + Left err -> throwM (YamlErr ident err) + Right (Object metaObj) -> return (Object metaObj) + Right Null -> return (Object HM.empty) + Right _ -> throwM (YamlErr ident "Top level yaml must be key-value pairs") + +-- | Given a resource identifier and the file contents; parses and returns +-- a 'Value' representing any metadata and the file contents. +processSource :: MonadThrow m => String -> String -> m (Value, String) +processSource ident source = do + (metaBlock, contents) <- splitMeta ident source + metaObj <- decodeMeta ident metaBlock + return (metaObj, contents) + diff --git a/src/SitePipe/Pipes.hs b/src/SitePipe/Pipes.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Pipes.hs @@ -0,0 +1,99 @@ +{-# language RecordWildCards #-} +{-# language OverloadedStrings #-} +module SitePipe.Pipes + ( site + , siteWithGlobals + ) where + + +import Control.Monad.Catch as Catch +import System.Directory +import Control.Monad.Reader +import Data.Foldable +import Control.Monad.Writer +import Options.Applicative +import qualified Text.Mustache.Types as MT +import qualified Data.HashMap.Strict as HM + +import SitePipe.Types + +-- | Build a site generator from a set of rules embedded in a 'SiteM'. +-- Use this in your @main@ function. +-- +-- > main :: IO () +-- > main = site $ do +-- > posts <- resourceLoader markdownReader ["posts/*.md"] +-- > writeTemplate "templates/post.html" posts +site :: SiteM () -> IO () +site = siteWithGlobals (MT.Object mempty) + +-- | Like 'site', but allows you to pass an 'MT.Value' Object which consists +-- of an environment which is available inside your templates. +-- +-- This is useful for globally providing utility functions for use in your templates. +-- +-- > import qualified Text.Mustache as MT +-- > import qualified Text.Mustache.Types as MT +-- > utilityFuncs :: MT.Value +-- > utilityFuncs = MT.object +-- > ["truncate" MT.~> MT.overText (T.take 30) +-- > ] +-- > +-- > main :: IO () +-- > main = siteWithGlobals utilityFuncs $ do +-- > -- your site ... +-- +-- > +-- > {{#truncate}} +-- > Anything inside this block will be truncated to 30 chars. +-- > {{vars}} are interpolated before applying the function. +-- > {{/truncate}} +siteWithGlobals :: MT.Value -> SiteM () -> IO () +siteWithGlobals globals spec = do + settings <- execParser settingsInfo >>= adjSettings + clean (outputDir settings) + (result, warnings) <- runWriterT (runReaderT (Catch.try spec) settings{globalContext=globals}) + case result of + Left err -> print (err :: SitePipeError) + Right _ -> unless (null warnings) (traverse_ putStrLn warnings) + +-- | Argument info for option parsing. +settingsInfo :: ParserInfo Settings +settingsInfo = info (settingsP <**> helper) + ( fullDesc <> + progDesc "Static site generator" <> + header "SitePipe - simple static site generator") + +-- | Settings parser +settingsP :: Parser Settings +settingsP = Settings <$> strOption srcD <*> strOption outputD <*> pure (MT.Object HM.empty) + where + srcD = mconcat [ help "The directory where site source is stored" + , metavar "SOURCE_DIR" + , short 's' + , value "./site" + , showDefault + ] + + outputD = mconcat [ help "Directory where site will be rendered" + , metavar "OUTPUT_DIR" + , short 'o' + , value "./dist" + , showDefault + ] + +-- | Make given source and output dirs relative. +adjSettings :: Settings -> IO Settings +adjSettings Settings{..} = do + outD <- makeAbsolute outputDir + srcD <- makeAbsolute srcDir + return Settings{outputDir=outD, srcDir=srcD, ..} + +-- | Remove output directory if it exists and set up for next write. +-- This is called by 'site' automatically. +clean :: FilePath -> IO () +clean outD = do + putStrLn $ "Purging " ++ outD + exists <- doesDirectoryExist outD + when exists (removeDirectoryRecursive outD) + createDirectoryIfMissing False outD diff --git a/src/SitePipe/Readers.hs b/src/SitePipe/Readers.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Readers.hs @@ -0,0 +1,34 @@ +module SitePipe.Readers + ( + -- * Built-in readers + markdownReader + , textReader + + -- * Reader Generators + , mkPandocReader + ) where + +import Text.Pandoc +import Control.Monad.Catch + +-- | Given any standard pandoc reader (see "Text.Pandoc"; e.g. 'readMarkdown', 'readDocX') +-- makes a resource reader compatible with 'SitePipe.Files.resourceLoader'. +-- +-- > docs <- resourceLoader (mkPandocReader readDocX) ["docs/*.docx"] +mkPandocReader :: (ReaderOptions -> String -> (Either PandocError Pandoc)) -> String -> IO String +mkPandocReader pReader content = writeHtmlString def <$> runPandocReader (pReader def) content + +-- | Runs the Pandoc reader handling errors. +runPandocReader :: (MonadThrow m) => (String -> Either PandocError Pandoc) -> String -> m Pandoc +runPandocReader panReader source = + case panReader source of + Left err -> throwM err + Right pandoc -> return pandoc + +-- | Reads markdown files into html +markdownReader :: String -> IO String +markdownReader = mkPandocReader readMarkdown + +-- | Reads text files without processing +textReader :: String -> IO String +textReader = return diff --git a/src/SitePipe/Templating.hs b/src/SitePipe/Templating.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Templating.hs @@ -0,0 +1,33 @@ +{-# language OverloadedStrings #-} +{-# language FlexibleContexts #-} +{-# language ViewPatterns #-} +module SitePipe.Templating + ( renderTemplate + ) where + +import qualified Text.Mustache as M +import qualified Data.Text as T +import Data.Text.Lens +import Control.Lens +import Data.Aeson.Lens +import Data.Aeson.Types +import SitePipe.Types +import Control.Monad.Writer +import Control.Monad.Reader +import qualified Text.Mustache.Types as MT + +-- | Given a template, produces a function compatible with 'SitePipe.Files.writeWith' +-- which writes resources using the template. +renderTemplate :: (ToJSON env) => M.Template -> env -> SiteM String +renderTemplate template (toJSON -> env) = do + gContext <- asks globalContext + let fullContext = addContext gContext (MT.toMustache env) + case M.checkedSubstitute template fullContext of + ([], result) -> return (T.unpack result) + (errs, r) -> do + tell $ ["*** Warnings rendering " ++ path ++ "***"] ++ (fmap show errs) ++ ["------"] + return (T.unpack r) + where + path = env ^. key "filepath" . _String . unpacked + addContext (MT.Object context) (MT.Object e) = MT.Object (context <> e) + addContext _ e = e diff --git a/src/SitePipe/Types.hs b/src/SitePipe/Types.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Types.hs @@ -0,0 +1,57 @@ +{-# language OverloadedStrings #-} +module SitePipe.Types + ( TemplatePath + , GlobPattern + , Settings(..) + , SiteM + , SitePipeError(..) + ) where + +import Control.Monad.Catch +import Text.Pandoc +import qualified Text.Megaparsec as MP +import qualified Text.Parsec as P +import Text.Mustache.Render (SubstitutionError) +import Control.Monad.Reader +import Control.Monad.Writer +import qualified Text.Mustache.Types as MT + +-- | String alias; Path to a template +type TemplatePath = String + +-- | String alias; Valid globbing pattern. Follows shell globbing, allows recursive @/**/*@ globs. +type GlobPattern = String + +-- | A monad collecting site instructions. Use liftIO to perform arbitrary IO. +type SiteM a = ReaderT Settings (WriterT [String] IO) a + +-- | Global Settings +data Settings = Settings + { srcDir :: FilePath + , outputDir :: FilePath + , globalContext :: MT.Value + } deriving Show + +-- | Collection of possible errors. +data SitePipeError = + YamlErr String String + | PParseErr P.ParseError + | MParseErr (MP.ParseError (MP.Token String) MP.Dec) + | PandocErr PandocError + | JSONErr String String + | TemplateParseErr P.ParseError + | TemplateInterpolateErr String [SubstitutionError] + | SitePipeError String + +instance Show SitePipeError where + show (YamlErr path err) = "YAML Parse Error in " ++ path ++ ":\n" ++ err + show (PandocErr err) = "Pandoc Error: " ++ show err + show (PParseErr err) = "Template Error: " ++ show err + show (MParseErr err) = "Meta-data Error: " ++ MP.parseErrorPretty err + show (JSONErr path err) = "JSON Parse Error in " ++ path ++ ":\n" ++ err + show (TemplateParseErr err) = "Template Parse Error: " ++ show err + show (TemplateInterpolateErr path errs) = + "Template Interpolation Errors in " ++ path ++ ":\n" ++ show errs + show (SitePipeError err) = err + +instance Exception SitePipeError diff --git a/src/SitePipe/Utilities.hs b/src/SitePipe/Utilities.hs new file mode 100644 --- /dev/null +++ b/src/SitePipe/Utilities.hs @@ -0,0 +1,16 @@ +{-# language OverloadedStrings #-} +module SitePipe.Utilities + ( addPrefix + , setExt + ) where + +import System.FilePath.Posix + +-- | Set the extension of a filepath or url to the given extension. +-- Use @setExt ""@ to remove any extension. +setExt :: String -> FilePath -> FilePath +setExt = flip replaceExtension + +-- | Add a prefix to a filepath or url +addPrefix :: String -> FilePath -> FilePath +addPrefix = (++) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"