stagen (empty) → 0.0.0

raw patch · 16 files changed

+468/−0 lines, 16 filesdep +aesondep +basedep +blaze-htmlsetup-changed

Dependencies added: aeson, base, blaze-html, bytestring, data-default, directory, filemanip, lucid, markdown, mtl, optparse-applicative, parallel, parsec, stagen, text

Files

• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• executable/Main.hs +6/−0
• library/Stagen/Build.hs +115/−0
• library/Stagen/Clean.hs +19/−0
• library/Stagen/Date.hs +23/−0
• library/Stagen/File.hs +47/−0
• library/Stagen/Init.hs +7/−0
• library/Stagen/Job.hs +7/−0
• library/Stagen/Main.hs +14/−0
• library/Stagen/Opts.hs +65/−0
• library/Stagen/Page.hs +12/−0
• library/Stagen/Template.hs +14/−0
• package.yaml +44/−0
• stagen.cabal +62/−0

@@ -0,0 +1,30 @@+Copyright (c) 2015, Joe Vargas++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 Joe Vargas 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.

@@ -0,0 +1,1 @@+# stagen

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,6 @@+module Main where++import qualified Stagen.Main++main :: IO ()+main = Stagen.Main.main

@@ -0,0 +1,115 @@+module Stagen.Build where++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import qualified Data.List as L+import qualified Text.Parsec as P+import qualified Text.Parsec.String as P+import Control.Arrow+import Control.Monad (void)+import System.FilePath.Find+import Data.Monoid+import Data.Maybe+import Lucid++import Stagen.Opts+import Stagen.Date+import Stagen.Template+import Stagen.Page+import Stagen.Job+import Stagen.File++runBuild :: Opts -> IO ()+runBuild opts@Opts{..} = do+    tpl <- mkTemplate opts+    let ignore = optsIgnore ++ catMaybes [optsHeader, optsFooter, optsArchive]+    files <- find (pure True) (eligable ignore) optsTargetDirectory+    htmlPathAndPages <- sequence $ map (fromMarkdown optsVerbose) files+    let archive = archiveJob optsVerbose tpl htmlPathAndPages optsArchive+    let pageAndHtmlPaths = map (\(page, path) -> (path, page)) htmlPathAndPages+    let jobs = archive : map (uncurry (writePage tpl)) pageAndHtmlPaths+    void $ runJobs optsJobs jobs++build :: Template -> Page -> TL.Text+build Template{..} Page{..} = renderText $ doctypehtml_ $ do+    head_ $ do+        void $ title_ (toHtmlRaw pageTitle)+        mapM_ (\href -> link_ [rel_ "stylesheet", type_ "text/css", href_ href]) (map TL.toStrict tplStyleSheets)+        mapM_ (\src -> termWith "script" [src_ src] "") (map TL.toStrict tplScripts)+    body_ . div_ [id_ "wrapper"] $ do+        div_ [id_ "header"] (try tplHeader)+        div_ [id_ "content"] (toHtmlRaw pageContent)+        div_ [id_ "footer"] (try tplFooter)+ where+    try = toHtmlRaw . fromMaybe TL.empty++archiveJob :: Verbose -> Template -> [(FilePath, Page)] -> Maybe FilePath -> IO ()+archiveJob verbose tpl htmlPathAndPages mMdPath = fromMaybe (return ()) $ do+    mdPath <- mMdPath+    return $ do+        (htmlPath, page) <- fromMarkdown verbose mdPath+        writePage tpl (addArchiveEntries page htmlPathAndPages) htmlPath++writePageFromMarkdown :: Verbose -> Template -> FilePath -> IO ()+writePageFromMarkdown verbose tpl mdPath = do+    (htmlPath, page) <- fromMarkdown verbose mdPath+    writePage tpl page htmlPath++writePage :: Template -> Page -> FilePath -> IO ()+writePage tpl page htmlPath = TL.writeFile htmlPath (build tpl page)++addArchiveEntries :: Page -> [(FilePath, Page)] -> Page+addArchiveEntries page htmlPathAndPages =+    let pathAndTitles = map (second pageTitle) htmlPathAndPages+        sorter = L.sortBy (\(_,_,a) (_,_,b)-> compare a b)+        content = (pageContent page) <> (toLinks . sorter . getEntries) pathAndTitles+    in Page{pageTitle = pageTitle page, pageContent = content}+ where+    getEntries :: [(FilePath, TL.Text)] -> [(FilePath, TL.Text, Date)]+    getEntries = catMaybes . map (\(f,t) -> fmap (f,t,) (parseMay datePrefix (baseName f)))++    toLinks :: [(FilePath, TL.Text, Date)] -> TL.Text+    toLinks = renderText . ul_ . toHtmlRaw . TL.concat . map toLink++    toLink :: (FilePath, TL.Text, Date) -> TL.Text+    toLink (path, title, date) =+        renderText+            (li_ (a_ [href_ (T.pack path)]+            (toHtmlRaw $ displayDate date <> " <span id=\"title\">" <> title <> "</span>")))++displayDate :: Date -> TL.Text+displayDate Date{..} = TL.concat+    [ TL.pack (show dateYear)+    , "-"+    , TL.pack (showTwoDigits dateMonth)+    , "-"+    , TL.pack (showTwoDigits dateDay)+    ]+ where+    showTwoDigits n+        | n < 10 = '0' : show n+        | otherwise = show n++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)++mkTemplate :: Opts -> IO Template+mkTemplate Opts{..} = do+    let tplStyleSheets = map TL.pack optsStyleSheets+    let tplScripts = map TL.pack optsScripts+    tplHeader <- go optsHeader+    tplFooter <- go optsFooter+    return Template{..}+ where+    go Nothing = return Nothing+    go (Just path) = Just <$> render <$> TL.readFile path

@@ -0,0 +1,19 @@+module Stagen.Clean where++import Control.Applicative (pure, (<$>))+import Data.Maybe (catMaybes)+import System.FilePath.Find (find)+import System.IO.Error (catchIOError)+import System.Directory (removeFile)++import Stagen.Opts+import Stagen.File++runClean :: Opts -> IO ()+runClean Opts{..} = do+    let ignore = optsIgnore ++ catMaybes [optsHeader, optsFooter]+    files <- find (pure True) (eligable ignore) optsTargetDirectory+    htmlPaths <- map fst <$> (sequence $ map (fromMarkdown optsVerbose) files)+    mapM_ (\p -> catchIOError (removeFile p) (const done)) htmlPaths+ where+    done = return ()

@@ -0,0 +1,23 @@+module Stagen.Date where++import Data.Functor (void)+import Text.Parsec+import Text.Parsec.String++data Date = Date {+    dateYear :: Int,+    dateMonth :: Int,+    dateDay :: Int+} deriving (Show, Eq, Ord)++datePrefix :: Parser Date+datePrefix = do+    year <- number+    void $ char '-'+    month <- number+    void $ char '-'+    day <- number+    void $ char '-'+    return (Date year month day)+ where+    number = fmap read (many1 digit)

@@ -0,0 +1,47 @@+module Stagen.File where++import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import Control.Monad (when)+import System.FilePath.Find+import Text.Markdown+import Text.Blaze.Html.Renderer.Text (renderHtml)++import Stagen.Opts+import Stagen.Page++fromMarkdown :: Verbose -> FilePath -> IO (FilePath, Page)+fromMarkdown verbose mdPath = do+    let htmlPath = changeExtension mdPath "html"+    page <- readPage 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)++readPage :: FilePath -> IO Page+readPage path = do+    content <- TL.readFile path+    let pageTitle = TL.filter (not . isMarkdownChar) (TL.takeWhile isNotNewLine content)+    let pageContent = render content+    return Page{..}+ 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

@@ -0,0 +1,7 @@+module Stagen.Init where++import Stagen.Opts++runInit :: Opts -> IO ()+runInit Opts{..} = do+    return ()

@@ -0,0 +1,7 @@+module Stagen.Job where++import Control.Monad (sequence)+import Control.Parallel.Strategies++runJobs :: Monad m => Int -> [m a] -> m [a]+runJobs n = sequence . runEval . evalBuffer n rseq

@@ -0,0 +1,14 @@+module Stagen.Main where++import Stagen.Opts+import Stagen.Init+import Stagen.Build+import Stagen.Clean++main :: IO ()+main = do+    opts <- parseOpts+    runByCommand (optsCommand opts) opts++runByCommand :: Command -> Opts -> IO ()+runByCommand = \case Init -> runInit; Build -> runBuild; Clean -> runClean

@@ -0,0 +1,65 @@+module Stagen.Opts where++import qualified Data.Text.Lazy as TL+import Data.Default+import Data.Bool (bool)+import Data.Monoid (mconcat, (<>))+import Options.Applicative+import Options.Applicative.Builder.Internal (HasName)++type TargetDirectory = FilePath++data Verbose = Verbose | Slient+    deriving (Show, Eq)++data Command = Init | Build | Clean+    deriving (Show, Eq)++data Opts = Opts {+    optsCommand :: Command,+    optsHeader :: Maybe FilePath,+    optsFooter :: Maybe FilePath,+    optsArchive :: Maybe FilePath,+    optsStyleSheets :: [FilePath],+    optsScripts :: [FilePath],+    optsIgnore :: [FilePath],+    optsJobs :: Int,+    optsVerbose :: Verbose,+    optsTargetDirectory :: TargetDirectory+} deriving Show++parseOpts :: IO Opts+parseOpts = execParser (info optsP idm)++optsP :: Parser Opts+optsP =+    let choice a c = command a (info (cmdOptsP c) (progDesc a))+        choices = mconcat [choice "init" Init, choice "build" Build, choice "clean" Clean]+    in subparser choices++cmdOptsP :: Command -> Parser Opts+cmdOptsP cmd = Opts cmd+    <$> tryStrArg 'e' "header" "Include header"+    <*> tryStrArg 'f' "footer" "Include footer"+    <*> tryStrArg 'a' "archive" "Prepend archive to generated page"+    <*> many (strArg 'c' "stylesheet" "Stylesheet file path")+    <*> many (strArg 's' "script" "Script file path")+    <*> many (strArg 'i' "ignore" "Don't render this file")+    <*> (option auto (arg 'j' "jobs" "Run ARG jobs simultaneously") <|> pure (optsJobs def))+    <*> fmap (bool Slient Verbose) (switch (arg 'v' "verbose" "Explain what is being done"))+    <*> targetDirectory++arg :: HasName f => Char -> String -> String -> Mod f a+arg s l h = short s <> long l <> help h++strArg :: Char -> String -> String -> Parser String+strArg c l i = strOption (arg c l i)++tryStrArg :: Char -> String -> String -> Parser (Maybe String)+tryStrArg c l i = fmap Just (strArg c l i) <|> pure Nothing++targetDirectory :: Parser TargetDirectory+targetDirectory = strArgument (metavar "TARGET_DIRECTORY") <|> pure (optsTargetDirectory def)++instance Default Opts where+    def = Opts Build Nothing Nothing Nothing [] [] [] 1 Slient "."

@@ -0,0 +1,12 @@+module Stagen.Page where++import qualified Data.Text.Lazy as TL+import Data.Default++data Page = Page {+    pageTitle :: TL.Text,+    pageContent :: TL.Text+} deriving Show++instance Default Page where+    def = Page TL.empty TL.empty

@@ -0,0 +1,14 @@+module Stagen.Template where++import qualified Data.Text.Lazy as TL+import Data.Default++data Template = Template {+    tplStyleSheets :: [TL.Text],+    tplScripts :: [TL.Text],+    tplHeader :: Maybe TL.Text,+    tplFooter :: Maybe TL.Text+} deriving Show++instance Default Template where+    def = Template [] [] Nothing Nothing

@@ -0,0 +1,44 @@+name: stagen+version: '0.0.0'+category: Web+synopsis: Static site generator+description: Low dependency static site generator using markdown+maintainer: Joe Vargas+license: BSD3+extra-source-files:+- package.yaml+- README.md+ghc-options: -Wall+default-extensions:+- LambdaCase+- OverloadedStrings+- TupleSections+- RecordWildCards+library:+  dependencies:+  - aeson+  - base >= 4.7 && < 5+  - bytestring+  - blaze-html+  - data-default+  - directory+  - filemanip+  - lucid+  - markdown+  - mtl+  - optparse-applicative+  - parallel+  - parsec+  - text+  source-dirs: library+executables:+  stagen:+    dependencies:+    - base+    - stagen+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: executable

@@ -0,0 +1,62 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           stagen+version:        0.0.0+synopsis:       Static site generator+description:    Low dependency static site generator using markdown+category:       Web+maintainer:     Joe Vargas+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    package.yaml+    README.md++library+  hs-source-dirs:+      library+  default-extensions: LambdaCase OverloadedStrings TupleSections RecordWildCards+  ghc-options: -Wall+  build-depends:+      aeson+    , base >= 4.7 && < 5+    , bytestring+    , blaze-html+    , data-default+    , directory+    , filemanip+    , lucid+    , markdown+    , mtl+    , optparse-applicative+    , parallel+    , parsec+    , text+  exposed-modules:+      Stagen.Build+      Stagen.Clean+      Stagen.Date+      Stagen.File+      Stagen.Init+      Stagen.Job+      Stagen.Main+      Stagen.Opts+      Stagen.Page+      Stagen.Template+  default-language: Haskell2010++executable stagen+  main-is: Main.hs+  hs-source-dirs:+      executable+  default-extensions: LambdaCase OverloadedStrings TupleSections RecordWildCards+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , stagen+  default-language: Haskell2010