module Stagen.File where import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL import qualified Text.Parsec as P import qualified Text.Parsec.String as P import Data.Text.Conversions (toText) import Data.Monoid ((<>)) import Control.Monad (when) import System.FilePath.Find import Text.Markdown import Text.Blaze.Html.Renderer.Text (renderHtml) import Stagen.Opts import Stagen.Page import Stagen.Date fromMarkdown :: Verbose -> FilePath -> FilePath -> IO (FilePath, Page) fromMarkdown verbose baseUrl mdPath = do let htmlPath = changeExtension mdPath "html" page <- readPage baseUrl mdPath when (verbose == Verbose) (putStrLn htmlPath) return (htmlPath, page) eligable :: [FilePath] -> FindClause Bool eligable ignore = do isMarkdown <- (== ".md") <$> extension name <- fileName let isFileName = and (map (/= name) ignore) return (isMarkdown && isFileName) absoluteUrl :: FilePath -> FilePath -> TL.Text absoluteUrl baseUrl path = TL.fromStrict . toText $ changeExtension (baseUrl <> "/" <> path) "html" readPage :: FilePath -> FilePath -> IO Page readPage baseUrl path = do content <- TL.readFile path let pageAbsoluteUrl = absoluteUrl baseUrl (drop 2 path) let pageDate = parseMay datePrefix (baseName path) let pageTitle = mkTitle content let pageContent = render content return Page{..} mkTitle :: TL.Text -> TL.Text mkTitle content = TL.filter (not . isMarkdownChar) (TL.takeWhile isNotNewLine content) where isMarkdownChar ch = ch == '_' || ch == '*' || ch == '#' || ch == '>' isNotNewLine ch = ch /= '\n' && ch /= '\r' changeExtension :: FilePath -> String -> FilePath changeExtension path newExtension | hasExt = basename ++ newExtension | otherwise = path ++ ('.' : newExtension) where revPath = reverse path hasExt = elem '.' (takeWhile (/= '/') revPath) basename = reverse (dropWhile (/= '.') revPath) render :: TL.Text -> TL.Text render = renderHtml . markdown def parseMay :: P.Parser a -> String -> Maybe a parseMay p src = case P.parse p "" src of Left _ -> Nothing Right x -> Just x baseName :: FilePath -> FilePath baseName path = basename where revPath = reverse path revName = takeWhile (/= '/') revPath basename = reverse (dropWhile (/= '.') revName)