Logan McGrath
2 years ago
33 changed files with 437 additions and 328 deletions
@ -0,0 +1,16 @@ |
|||
--- |
|||
title: "Open Source in the Age of GitHub" |
|||
author: "Logan McGrath" |
|||
date: 2021-06-18T18:02:00-07:00 |
|||
comments: false |
|||
published: false |
|||
layout: post |
|||
body-class: open-source-in-the-age-of-github |
|||
tags: |
|||
- Open Source |
|||
- Software Licenses |
|||
--- |
|||
|
|||
```{.markdown} |
|||
$getCode("LICENSE.md")$ |
|||
``` |
|||
@ -0,0 +1,25 @@ |
|||
Copyright (c) <year> <copyright holder>. All Rights Reserved. |
|||
|
|||
We as individuals and organizations, and as contributors to open source software and thus value produced by their exploitation, have the right to require, collectively or individually, due acknowledgment of resources expended to produce the value provided by this software. |
|||
|
|||
Value produced by this software includes not only the value intended but also any value that may be derived from the software in any form in which it exists at present or in forms derived. |
|||
|
|||
Exploitation of value produced by this software is bound by these five terms. |
|||
|
|||
1. This license permits enforcement of these terms upon exploitation of value related by transitive property to the exploitation of value produced by this software if the copyright holder and contributors, collectively or individually, expend the resources required to do so without blowing the stack. |
|||
|
|||
2. Exploitation of value produced by this software permits the copyright holder and contributors, collectively or individually, to require due acknowledgement of the expenditure of resources required to produce the value provided by this software. Due acknowledgement must be given in a manner that is contemporaneously competitive and under these terms this license thus proposes appropriate due acknowledgement is constituted by hearty high-five. |
|||
|
|||
3. Exploitation of value produced by this software in absence of due acknowledgement required by its copyright holder and contributors, collectively or individually, constitutes a high-five left hanging and implies freeloading. |
|||
|
|||
4. Exploitation of value produced by this software by a freeloader permits the following items. |
|||
|
|||
4.1. The copyright holder and contributors, collectively or individually, may post written notice to the freeloader that exploitation of the value produced by this software requires receipt of a hearty high-five. |
|||
|
|||
4.2. The copyright holder and contributors, collectively or individually, may to the community at large in an accessible, discoverable manner post written notice that a freeloader has left them hanging if the freeloader continues to exploit value produced by this software after any period of time deemed appropriate by the copyright holder and contributors, collectively or individually. |
|||
|
|||
4.3. Posted notices of freeloading must be retracted in writing when the freeloader provides written acknowledgement of having left the copyright holders and contributors hanging and with them collectively brings it in and makes up with a hearty high-five. |
|||
|
|||
5. Pedantism of terms to favor freeloading is provided no rights nor protections by this license whatsoever as the value of such is solely the express enabling of scabbed enlightenment by freeloading upon the value of exploitation itself. |
|||
|
|||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS” WITH ABSOLUTELY NO WARRANTY WHATSOEVER. COPYRIGHT HOLDERS AND CONTRIBUTORS ARE NOT LIABLE FOR ANY DAMAGES CAUSED BY THE SOFTWARE OR ITS MEANS OF PRODUCTION WHATSOEVER INCLUDING ESPECIALLY ANY DESERVED PUNCH TO THE NOSE. |
|||
@ -0,0 +1,3 @@ |
|||
.high-five-license { |
|||
max-width: 60rem; |
|||
} |
|||
@ -1,2 +1,3 @@ |
|||
@import "theme"; |
|||
@import "pages/homepage"; |
|||
@import "blog/open-source-in-the-age-of-github" |
|||
|
|||
@ -1,93 +1,134 @@ |
|||
module Green.Compiler.Layout where |
|||
|
|||
import Data.Binary as B |
|||
import Data.ByteString.Lazy as LBS |
|||
import GHC.Generics hiding (to) |
|||
import qualified Data.ByteString.Lazy as LBS |
|||
import GHC.Generics |
|||
import Green.Common |
|||
import Green.Config |
|||
import Green.Util |
|||
|
|||
layoutCompiler :: Compiler (Item Layout) |
|||
layoutCompiler = do |
|||
template <- templateBodyCompiler |
|||
fields <- layoutMetadataCompiler =<< getUnderlying |
|||
makeItem $ Layout template fields |
|||
|
|||
applyLayout :: SiteConfig -> Item String -> Compiler (Item String) |
|||
applyLayout config item = do |
|||
metadata <- layoutMetadataCompiler (itemIdentifier item) |
|||
stack <- buildStack (metadataParent metadata) (stackFromMetadata metadata) |
|||
let context = stackContext stack <> config ^. siteContext |
|||
debugCompiler $ |
|||
"[LayoutStack " ++ toFilePath (itemIdentifier item) ++ "]\n" |
|||
++ unlines |
|||
[ "templates => " ++ commas (toFilePath . itemIdentifier <$> stackTemplates stack), |
|||
"body-class => " ++ commas (stackBodyClasses stack), |
|||
"scripts => " ++ commas (itemBody <$> stackScripts stack), |
|||
"stylesheets => " ++ commas (itemBody <$> stackStylesheets stack) |
|||
] |
|||
go (itemBody <$> stackTemplates stack) context item |
|||
where |
|||
go (template : rest) context body = go rest context =<< applyTemplate template context body |
|||
go [] _ body = return body |
|||
buildStack Nothing stack = return stack |
|||
buildStack (Just parentId) stack = do |
|||
layout <- itemBody <$> loadLayout parentId |
|||
buildStack (layoutParent layout) (stackAppendLayout layout stack) |
|||
layoutParent = metadataParent . layoutMetadata |
|||
|
|||
loadLayout :: Identifier -> Compiler (Item Layout) |
|||
loadLayout = load |
|||
|
|||
data Layout = Layout |
|||
{ _layoutStack :: [Item Template], |
|||
_layoutScripts :: [Item String], |
|||
_layoutStylesheets :: [Item String] |
|||
{ layoutTemplate :: Item Template, |
|||
layoutMetadata :: LayoutMetadata |
|||
} |
|||
deriving stock (Generic) |
|||
|
|||
makeLenses ''Layout |
|||
deriving stock (Show, Generic) |
|||
|
|||
instance Binary Layout where |
|||
get = Layout <$> get <*> get <*> get |
|||
get = Layout <$> get <*> get |
|||
put layout = |
|||
put (layout ^. layoutStack) |
|||
>> put (layout ^. layoutScripts) |
|||
>> put (layout ^. layoutStylesheets) |
|||
put (layoutTemplate layout) |
|||
>> put (layoutMetadata layout) |
|||
|
|||
instance Writable Layout where |
|||
write p = LBS.writeFile p . B.encode . itemBody |
|||
|
|||
layoutKey :: String |
|||
layoutKey = "layout" |
|||
|
|||
layoutScriptsKey :: String |
|||
layoutScriptsKey = "scripts" |
|||
|
|||
layoutStylesheetsKey :: String |
|||
layoutStylesheetsKey = "stylesheets" |
|||
|
|||
layoutContext :: SimpleGetter Layout (Context String) |
|||
layoutContext = to \layout -> |
|||
listField layoutScriptsKey context (return $ layout ^. layoutScripts) |
|||
<> listField layoutStylesheetsKey context (return $ layout ^. layoutStylesheets) |
|||
where |
|||
context = bodyField "src" |
|||
|
|||
loadLayoutFromMetadata :: Metadata -> Compiler (Maybe (Item Layout)) |
|||
loadLayoutFromMetadata metadata = |
|||
mapM (loadLayout . fromLayoutName) (lookupString layoutKey metadata) |
|||
|
|||
applyLayoutFromMetadata :: SiteConfig -> Item String -> Compiler (Item String) |
|||
applyLayoutFromMetadata config item = do |
|||
metadata <- getMetadata $ itemIdentifier item |
|||
maybeLayout <- loadLayoutFromMetadata metadata |
|||
let f layout = applyLayout config layout item |
|||
maybe (return item) f maybeLayout |
|||
|
|||
applyLayout :: SiteConfig -> Item Layout -> Item String -> Compiler (Item String) |
|||
applyLayout config layout = go templates |
|||
where |
|||
templates = itemBody <$> layout ^. to itemBody . layoutStack |
|||
context = bodyField "body" <> config ^. siteContext |
|||
go (t : ts) = go ts <=< applyTemplate t context |
|||
go [] = return |
|||
|
|||
loadLayout :: Identifier -> Compiler (Item Layout) |
|||
loadLayout = load |
|||
|
|||
layoutCompiler :: Compiler (Item Layout) |
|||
layoutCompiler = do |
|||
metadata <- getMetadata =<< getUnderlying |
|||
template <- makeItem =<< compileTemplateItem =<< getResourceBody |
|||
parent <- loadLayoutFromMetadata metadata |
|||
|
|||
let parentScripts = parentItems layoutScripts parent |
|||
scripts = parentScripts ++ toUrlItems (lookupStringList layoutScriptsKey metadata) |
|||
|
|||
parentStylesheets = parentItems layoutStylesheets parent |
|||
stylesheets = parentStylesheets ++ toUrlItems (lookupStringList layoutStylesheetsKey metadata) |
|||
|
|||
parentStack = parentItems layoutStack parent |
|||
stack = template : parentStack |
|||
|
|||
makeItem |
|||
Layout |
|||
{ _layoutStack = stack, |
|||
_layoutScripts = scripts, |
|||
_layoutStylesheets = stylesheets |
|||
} |
|||
data LayoutMetadata = LayoutMetadata |
|||
{ metadataParent :: Maybe Identifier, |
|||
metadataBodyClasses :: [String], |
|||
metadataScripts :: [Item String], |
|||
metadataStylesheets :: [Item String] |
|||
} |
|||
deriving stock (Show, Generic) |
|||
|
|||
instance Binary LayoutMetadata where |
|||
get = LayoutMetadata <$> get <*> get <*> get <*> get |
|||
put metadata = |
|||
put (metadataParent metadata) |
|||
>> put (metadataBodyClasses metadata) |
|||
>> put (metadataScripts metadata) |
|||
>> put (metadataStylesheets metadata) |
|||
|
|||
layoutMetadataCompiler :: Identifier -> Compiler LayoutMetadata |
|||
layoutMetadataCompiler id' = do |
|||
metadata <- getMetadata id' |
|||
let listFromKeys keys = fromMaybe [] $ firstMaybe $ [flip lookupStringList metadata, fmap pure . flip lookupString metadata] <*> keys |
|||
scripts = toUrlItems $ listFromKeys ["scripts", "script"] |
|||
stylesheets = toUrlItems $ listFromKeys ["stylesheets", "stylesheet"] |
|||
bodyClasses = listFromKeys ["body-classes", "body-class"] |
|||
parentId = fromLayoutName <$> lookupString "layout" metadata |
|||
fields = |
|||
LayoutMetadata |
|||
{ metadataParent = parentId, |
|||
metadataBodyClasses = bodyClasses, |
|||
metadataScripts = scripts, |
|||
metadataStylesheets = stylesheets |
|||
} |
|||
debugCompiler $ |
|||
"[LayoutMetadata " ++ toFilePath id' ++ "]\n" |
|||
++ unlines |
|||
[ "layout => " ++ maybe "ROOT" show parentId, |
|||
"body-class => " ++ commas bodyClasses, |
|||
"scripts => " ++ commas (itemBody <$> scripts), |
|||
"stylesheets => " ++ commas (itemBody <$> stylesheets) |
|||
] |
|||
return fields |
|||
where |
|||
toUrlItems = maybe [] (fmap toUrlItem) |
|||
toUrlItems = fmap toUrlItem |
|||
toUrlItem filePath = Item (fromFilePath filePath) (toUrl filePath) |
|||
parentItems lens' = maybe [] (^. to itemBody . lens') |
|||
fromLayoutName name = fromFilePath $ "_layouts/" ++ name ++ ".html" |
|||
|
|||
data LayoutStack = LayoutStack |
|||
{ stackTemplates :: [Item Template], |
|||
stackBodyClasses :: [String], |
|||
stackScripts :: [Item String], |
|||
stackStylesheets :: [Item String] |
|||
} |
|||
|
|||
fromLayoutName :: String -> Identifier |
|||
fromLayoutName name = fromFilePath ("_layouts/" ++ name ++ ".html") |
|||
stackFromMetadata :: LayoutMetadata -> LayoutStack |
|||
stackFromMetadata metadata = |
|||
LayoutStack |
|||
{ stackTemplates = mempty, |
|||
stackBodyClasses = metadataBodyClasses metadata, |
|||
stackScripts = metadataScripts metadata, |
|||
stackStylesheets = metadataStylesheets metadata |
|||
} |
|||
|
|||
stackAppendLayout :: Layout -> LayoutStack -> LayoutStack |
|||
stackAppendLayout layout stack = |
|||
let LayoutStack templates bodyClasses scripts stylesheets = stack |
|||
Layout template (LayoutMetadata _ mdBodyClasses mdScripts mdStylesheets) = layout |
|||
in LayoutStack |
|||
(templates <> pure template) |
|||
(bodyClasses <> mdBodyClasses) |
|||
(scripts <> mdScripts) |
|||
(stylesheets <> mdStylesheets) |
|||
|
|||
stackContext :: LayoutStack -> Context String |
|||
stackContext (LayoutStack _ bodyClasses scripts stylesheets) = |
|||
mconcat |
|||
[ constField "bodyClass" (unwords bodyClasses), |
|||
listField "scripts" (bodyField "src") (return scripts), |
|||
listField "stylesheets" (bodyField "href") (return stylesheets) |
|||
] |
|||
|
|||
@ -0,0 +1,16 @@ |
|||
module Green.Lens |
|||
( module Green.Lens, |
|||
module Green.Lens.Hakyll, |
|||
module Green.Lens.TH, |
|||
) |
|||
where |
|||
|
|||
import Green.Common |
|||
import Green.Lens.Hakyll |
|||
import Green.Lens.TH |
|||
|
|||
(~<>) :: (Monoid a) => ASetter s t a a -> a -> s -> t |
|||
(~<>) l a = over l (`mappend` a) |
|||
{-# INLINE (~<>) #-} |
|||
|
|||
infixr 4 ~<> |
|||
Loading…
Reference in new issue