diff --git a/src/License.elm b/src/License.elm new file mode 100644 index 0000000..eb5235b --- /dev/null +++ b/src/License.elm @@ -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) diff --git a/src/Modules.elm b/src/License/Hippocratic.elm similarity index 77% rename from src/Modules.elm rename to src/License/Hippocratic.elm index f8ca0fa..89b4dcb 100644 --- a/src/Modules.elm +++ b/src/License/Hippocratic.elm @@ -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") + ] diff --git a/src/License/NPL.elm b/src/License/NPL.elm new file mode 100644 index 0000000..59c8b28 --- /dev/null +++ b/src/License/NPL.elm @@ -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") + ] diff --git a/src/Main.elm b/src/Main.elm index 774cc41..7f99c67 100644 --- a/src/Main.elm +++ b/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 ]