Big refactor + multilicense support + basic license building
This commit is contained in:
parent
9c692f4561
commit
41af1105e9
GPG key ID:
45E9C6E81BD86E7C
115
src/License.elm
Normal file
115
src/License.elm
Normal file
|
|
@ -0,0 +1,115 @@
|
|||
module License exposing
|
||||
( assemble
|
||||
, compileTemplate
|
||||
, DownloadType (..)
|
||||
, downloadExt
|
||||
, download
|
||||
, downloadMime
|
||||
, empty
|
||||
, License
|
||||
, LicenseInfo
|
||||
, Template
|
||||
, ModuleInfo
|
||||
, moduleSorter
|
||||
, toggleModule
|
||||
)
|
||||
|
||||
import Html exposing (Html)
|
||||
import Sort exposing (Sorter)
|
||||
import Sort.Set as Set exposing (Set)
|
||||
import File.Download as Download
|
||||
|
||||
-- Download Types
|
||||
|
||||
type DownloadType
|
||||
= Plain
|
||||
| Markdown
|
||||
| Html
|
||||
|
||||
downloadMime : DownloadType -> String
|
||||
downloadMime dtype =
|
||||
case dtype of
|
||||
Plain -> "text/plain"
|
||||
Markdown -> "text/markdown"
|
||||
Html -> "text/html"
|
||||
|
||||
downloadExt : DownloadType -> String
|
||||
downloadExt dtype =
|
||||
case dtype of
|
||||
Plain -> "txt"
|
||||
Markdown -> "md"
|
||||
Html -> "html"
|
||||
|
||||
|
||||
-- Modules
|
||||
|
||||
type alias ModuleInfo =
|
||||
{ name: String
|
||||
, desc: List (Html Never)
|
||||
, index: Int
|
||||
}
|
||||
|
||||
moduleSorter : (modtype -> ModuleInfo) -> Sorter modtype
|
||||
moduleSorter info =
|
||||
Sort.by (info >> .index) Sort.increasing
|
||||
|
||||
|
||||
-- Templates
|
||||
|
||||
type alias Template modtype = List (Maybe modtype, String)
|
||||
|
||||
compileTemplate : Set modtype -> Template modtype -> String
|
||||
compileTemplate modules template =
|
||||
template
|
||||
|> List.filterMap (checkTemplateFrame modules)
|
||||
|> String.join ""
|
||||
|
||||
checkTemplateFrame : Set modtype -> (Maybe modtype, String) -> Maybe String
|
||||
checkTemplateFrame modules (maybemod, content) =
|
||||
case maybemod of
|
||||
Just mod -> if Set.memberOf modules mod then Just content else Nothing
|
||||
Nothing -> Just content
|
||||
|
||||
|
||||
-- Licenses
|
||||
|
||||
type alias License modtype =
|
||||
{ activeModules : Set modtype
|
||||
, info : LicenseInfo modtype
|
||||
}
|
||||
|
||||
type alias LicenseInfo modtype =
|
||||
{ availableModules : List modtype
|
||||
, templates : DownloadType -> Template modtype
|
||||
, moduleInfo : modtype -> ModuleInfo
|
||||
}
|
||||
|
||||
empty : LicenseInfo modtype -> License modtype
|
||||
empty info =
|
||||
License
|
||||
(Set.empty (moduleSorter info.moduleInfo))
|
||||
info
|
||||
|
||||
addOrRemove : Bool -> (a -> Set a -> Set a)
|
||||
addOrRemove isAdding =
|
||||
if isAdding
|
||||
then Set.insert
|
||||
else Set.remove
|
||||
|
||||
toggleModule : Bool -> modtype -> License modtype -> License modtype
|
||||
toggleModule newState mod license =
|
||||
{ license | activeModules = (addOrRemove newState) mod license.activeModules }
|
||||
|
||||
-- License Assembly
|
||||
|
||||
assemble : DownloadType -> License mtype -> String
|
||||
assemble dtype license =
|
||||
license.info.templates dtype
|
||||
|> compileTemplate license.activeModules
|
||||
|
||||
download : DownloadType -> License mtype -> Cmd msg
|
||||
download dtype modules =
|
||||
Download.string
|
||||
("LICENSE." ++ (downloadExt dtype))
|
||||
(downloadMime dtype)
|
||||
(assemble dtype modules)
|
||||
|
|
@ -1,20 +1,23 @@
|
|||
module Modules exposing
|
||||
module License.Hippocratic exposing
|
||||
( Module
|
||||
, all_modules
|
||||
, build_license
|
||||
, download_license
|
||||
, DownloadType(..)
|
||||
, ModuleInfo
|
||||
, module_info
|
||||
, module_property
|
||||
, module_desc
|
||||
, module_sorter
|
||||
, info
|
||||
)
|
||||
|
||||
import Html exposing (Html, text, a)
|
||||
import License exposing
|
||||
( DownloadType
|
||||
, LicenseInfo
|
||||
, ModuleInfo
|
||||
)
|
||||
import Html exposing (text)
|
||||
import Html exposing (a)
|
||||
import Html.Attributes exposing (href)
|
||||
import Sort exposing (Sorter)
|
||||
import File.Download as Download
|
||||
|
||||
info : LicenseInfo Module
|
||||
info =
|
||||
{ availableModules = availableModules
|
||||
, templates = getTemplate
|
||||
, moduleInfo = moduleInfo
|
||||
}
|
||||
|
||||
type Module
|
||||
= CarbonUnderground
|
||||
|
|
@ -34,8 +37,8 @@ type Module
|
|||
| SupplyChain
|
||||
| Copyleft
|
||||
|
||||
all_modules : List Module
|
||||
all_modules =
|
||||
availableModules : List Module
|
||||
availableModules =
|
||||
[ CarbonUnderground
|
||||
, Ecocide
|
||||
, Extractive
|
||||
|
|
@ -54,14 +57,8 @@ all_modules =
|
|||
, Copyleft
|
||||
]
|
||||
|
||||
type alias ModuleInfo =
|
||||
{ name: String
|
||||
, desc: List (Html Never)
|
||||
, index: Int
|
||||
}
|
||||
|
||||
module_info : Module -> ModuleInfo
|
||||
module_info mod = case mod of
|
||||
moduleInfo : Module -> ModuleInfo
|
||||
moduleInfo mod = case mod of
|
||||
CarbonUnderground ->
|
||||
{ name = "Carbon Underground 200"
|
||||
, desc =
|
||||
|
|
@ -239,45 +236,23 @@ module_info mod = case mod of
|
|||
, index = 15
|
||||
}
|
||||
|
||||
module_property : (ModuleInfo -> a) -> Module -> a
|
||||
module_property adapter mod = adapter (module_info mod)
|
||||
|
||||
module_desc : Module -> List (Html a)
|
||||
module_desc mod =
|
||||
module_property .desc mod
|
||||
|> List.map (Html.map never)
|
||||
|
||||
module_sorter : Sorter Module
|
||||
module_sorter = Sort.by (module_property .index) Sort.increasing
|
||||
|
||||
-- License Building
|
||||
|
||||
type DownloadType
|
||||
= Plain
|
||||
| Markdown
|
||||
| Html
|
||||
|
||||
download_mime : DownloadType -> String
|
||||
download_mime dtype =
|
||||
case dtype of
|
||||
Plain -> "text/plain"
|
||||
Markdown -> "text/markdown"
|
||||
Html -> "text/html"
|
||||
|
||||
download_ext : DownloadType -> String
|
||||
download_ext dtype =
|
||||
case dtype of
|
||||
Plain -> "txt"
|
||||
Markdown -> "md"
|
||||
Html -> "html"
|
||||
|
||||
build_license : DownloadType -> List Module -> String
|
||||
build_license dtype modules =
|
||||
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa!"
|
||||
|
||||
download_license : DownloadType -> List Module -> Cmd msg
|
||||
download_license dtype modules =
|
||||
Download.string
|
||||
("LICENSE." ++ (download_ext dtype))
|
||||
(download_mime dtype)
|
||||
(build_license dtype modules)
|
||||
getTemplate : DownloadType -> List (Maybe Module, String)
|
||||
getTemplate _ =
|
||||
[ (Nothing, "Hippocratic filler text")
|
||||
, (Just CarbonUnderground, "CU200 enabled")
|
||||
, (Just Ecocide, "Ecocide enabled")
|
||||
, (Just Extractive, "Extractive enabled")
|
||||
, (Just BDS, "BDS enabled")
|
||||
, (Just Taliban, "Taliban enabled")
|
||||
, (Just Myanmar, "Myanmar enabled")
|
||||
, (Just XinjiangUygar, "Uygar enabled")
|
||||
, (Just UsTariff, "UST enabled")
|
||||
, (Just Surveillance, "Surv enabled")
|
||||
, (Just Military, "MILI enabled")
|
||||
, (Just LawEnforcement, "COPS enabled")
|
||||
, (Just Media, "MEDIA enabled")
|
||||
, (Just SocialAuditing, "AUDIT enabled")
|
||||
, (Just BoardOfDirectors, "BOD enabled")
|
||||
, (Just SupplyChain, "CHAIN enabled")
|
||||
, (Just Copyleft, "COPYLEFT enabled")
|
||||
]
|
||||
63
src/License/NPL.elm
Normal file
63
src/License/NPL.elm
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
module License.NPL exposing
|
||||
( Module
|
||||
, info
|
||||
)
|
||||
|
||||
import License exposing
|
||||
( DownloadType
|
||||
, LicenseInfo
|
||||
, ModuleInfo
|
||||
)
|
||||
import Html exposing (text)
|
||||
|
||||
info : LicenseInfo Module
|
||||
info =
|
||||
{ availableModules = availableModules
|
||||
, templates = getTemplate
|
||||
, moduleInfo = moduleInfo
|
||||
}
|
||||
|
||||
type Module
|
||||
= WorkerOwnership
|
||||
| Attribution
|
||||
|
||||
availableModules : List Module
|
||||
availableModules =
|
||||
[ WorkerOwnership
|
||||
, Attribution
|
||||
]
|
||||
|
||||
moduleInfo : Module -> ModuleInfo
|
||||
moduleInfo mod = case mod of
|
||||
WorkerOwnership ->
|
||||
{ name = "Worker Ownership"
|
||||
, desc =
|
||||
[ text
|
||||
"""
|
||||
Restrict comercial use of your software to worker-owned businesses and
|
||||
collectives. Rights are still granted for non-comercial use by traditional
|
||||
businesses and individuals.
|
||||
"""
|
||||
]
|
||||
, index = 0
|
||||
}
|
||||
Attribution ->
|
||||
{ name = "Attribution"
|
||||
, desc =
|
||||
[ text
|
||||
"""
|
||||
Require that anyone who uses the software list your name/psuedonym, the original
|
||||
title of the software, the website/repository of the project, and credit in the
|
||||
case of attribution. You can always ask distributors to take down the attribution
|
||||
as well
|
||||
"""
|
||||
]
|
||||
, index = 1
|
||||
}
|
||||
|
||||
getTemplate : DownloadType -> List (Maybe Module, String)
|
||||
getTemplate _ =
|
||||
[ (Nothing, "NPL filler text")
|
||||
, (Just WorkerOwnership, "+ Cooperative")
|
||||
, (Just Attribution, "+ Attribution")
|
||||
]
|
||||
84
src/Main.elm
84
src/Main.elm
|
|
@ -1,21 +1,16 @@
|
|||
module Main exposing (main)
|
||||
|
||||
import Browser
|
||||
import Sort.Set exposing (Set)
|
||||
import Sort.Set as Set exposing (Set)
|
||||
import Html exposing (Html, div, input, label, p, section, text, h3)
|
||||
import Html.Events exposing (onCheck, onClick)
|
||||
import Html.Attributes exposing (class, type_, id)
|
||||
import Modules exposing
|
||||
( Module
|
||||
, all_modules
|
||||
, download_license
|
||||
, DownloadType(..)
|
||||
, module_property
|
||||
, module_desc
|
||||
, module_sorter
|
||||
)
|
||||
import Html.Attributes exposing (attribute)
|
||||
|
||||
import License exposing (License, DownloadType (..))
|
||||
import License.Hippocratic as Hippocratic
|
||||
import License.NPL as NPL
|
||||
|
||||
main: Program () Model Msg
|
||||
main =
|
||||
Browser.element
|
||||
|
|
@ -30,65 +25,86 @@ subscriptions _ = Sub.none
|
|||
|
||||
-- INIT + Model
|
||||
|
||||
type SelectedLicense
|
||||
= Hippocratic
|
||||
| NPL
|
||||
|
||||
type alias Model =
|
||||
{ enabled_modules : Set Module
|
||||
{ selected : SelectedLicense
|
||||
, hippocratic : License Hippocratic.Module
|
||||
, npl : License NPL.Module
|
||||
}
|
||||
|
||||
init : () -> (Model, Cmd Msg)
|
||||
init () =
|
||||
( { enabled_modules = Sort.Set.empty module_sorter }
|
||||
(
|
||||
{ selected = Hippocratic
|
||||
, hippocratic = License.empty Hippocratic.info
|
||||
, npl = License.empty NPL.info
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
-- UPDATE
|
||||
|
||||
type Msg
|
||||
= ToggleModule Module Bool
|
||||
| Download DownloadType
|
||||
= SwitchLicense SelectedLicense
|
||||
| ToggleModule AnyModule Bool
|
||||
| Download License.DownloadType
|
||||
|
||||
add_or_remove : Bool -> (a -> Set a -> Set a)
|
||||
add_or_remove active =
|
||||
if active then
|
||||
Sort.Set.insert
|
||||
else
|
||||
Sort.Set.remove
|
||||
type AnyModule
|
||||
= HippocraticMod Hippocratic.Module
|
||||
| NPLMod NPL.Module
|
||||
|
||||
type alias ModuleWrapper mtype = mtype -> AnyModule
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model =
|
||||
case msg of
|
||||
SwitchLicense newLicense ->
|
||||
( { model | selected = newLicense }
|
||||
, Cmd.none
|
||||
)
|
||||
ToggleModule mod enabled ->
|
||||
( { model | enabled_modules = add_or_remove enabled mod model.enabled_modules }
|
||||
( case mod of
|
||||
HippocraticMod modu ->
|
||||
{ model | hippocratic = License.toggleModule enabled modu model.hippocratic }
|
||||
NPLMod modu ->
|
||||
{ model | npl = License.toggleModule enabled modu model.npl }
|
||||
, Cmd.none
|
||||
)
|
||||
Download dtype ->
|
||||
( model , download_license dtype (Sort.Set.toList model.enabled_modules) )
|
||||
( model
|
||||
, case model.selected of
|
||||
Hippocratic -> License.download dtype model.hippocratic
|
||||
NPL -> License.download dtype model.npl
|
||||
)
|
||||
|
||||
-- VIEW
|
||||
|
||||
view_module_button : Set Module -> Module -> Html Msg
|
||||
view_module_button enabled mod =
|
||||
view_module_button : ModuleWrapper moduleType -> (moduleType -> License.ModuleInfo) -> Set moduleType -> moduleType -> Html Msg
|
||||
view_module_button wrapModule moduleInfo enabled mod =
|
||||
label
|
||||
(class "module-button"
|
||||
:: (if Sort.Set.memberOf enabled mod then [class "active"] else [])
|
||||
:: (if Set.memberOf enabled mod then [class "active"] else [])
|
||||
)
|
||||
[ div []
|
||||
[ div [class "cooler-checkbox"]
|
||||
[ input
|
||||
[ type_ "checkbox"
|
||||
, onCheck (ToggleModule mod)
|
||||
, onCheck (ToggleModule (wrapModule mod))
|
||||
] []
|
||||
]
|
||||
, h3 [] [ text (module_property .name mod) ]
|
||||
, p [] (module_desc mod)
|
||||
, h3 [] [ text (.name (moduleInfo mod)) ]
|
||||
, Html.map never (p [] (.desc (moduleInfo mod)))
|
||||
]
|
||||
]
|
||||
|
||||
view_modules : Set Module -> Html Msg
|
||||
view_modules modules =
|
||||
view_modules : ModuleWrapper moduleType -> License moduleType -> Html Msg
|
||||
view_modules wrap license =
|
||||
section [id "modules"] (
|
||||
all_modules
|
||||
|> List.map (view_module_button modules)
|
||||
license.info.availableModules
|
||||
|> List.map (view_module_button wrap license.info.moduleInfo license.activeModules)
|
||||
)
|
||||
|
||||
view_cooler_button : String -> msg -> Html msg
|
||||
|
|
@ -128,6 +144,8 @@ downloads =
|
|||
view : Model -> Html Msg
|
||||
view model =
|
||||
div [id "elm-area"]
|
||||
[ view_modules model.enabled_modules
|
||||
[ case model.selected of
|
||||
Hippocratic -> view_modules HippocraticMod model.hippocratic
|
||||
NPL -> view_modules NPLMod model.npl
|
||||
, downloads
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in a new issue