Big refactor + multilicense support + basic license building

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)

src/License/Hippocratic.elm

@@ -1,20 +1,23 @@
-module Modules exposing
+module License.Hippocratic exposing
   ( Module
-  , all_modules
+  , info
-  , build_license
-  , download_license
-  , DownloadType(..)
-  , ModuleInfo
-  , module_info
-  , module_property
-  , module_desc
-  , module_sorter
   )
 
-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
+availableModules : List Module
-all_modules =
+availableModules =
   [ CarbonUnderground
   , Ecocide
   , Extractive
@@ -54,14 +57,8 @@ all_modules =
   , Copyleft
   ]
 
-type alias ModuleInfo =
+moduleInfo : Module -> ModuleInfo
-  { name: String
+moduleInfo mod = case mod of
-  , desc: List (Html Never)
-  , index: Int
-  }
-
-module_info : Module -> ModuleInfo
-module_info 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
+getTemplate : DownloadType -> List (Maybe Module, String)
-module_property adapter mod = adapter (module_info mod)
+getTemplate _ =
-
+  [ (Nothing, "Hippocratic filler text")
-module_desc : Module -> List (Html a)
+  , (Just CarbonUnderground, "CU200 enabled")
-module_desc mod =
+  , (Just Ecocide, "Ecocide enabled")
-  module_property .desc mod
+  , (Just Extractive, "Extractive enabled")
-    |> List.map (Html.map never)
+  , (Just BDS, "BDS enabled")
-
+  , (Just Taliban, "Taliban enabled")
-module_sorter : Sorter Module
+  , (Just Myanmar, "Myanmar enabled")
-module_sorter = Sort.by (module_property .index) Sort.increasing
+  , (Just XinjiangUygar, "Uygar enabled")
-
+  , (Just UsTariff, "UST enabled")
--- License Building
+  , (Just Surveillance, "Surv enabled")
-
+  , (Just Military, "MILI enabled")
-type DownloadType
+  , (Just LawEnforcement, "COPS enabled")
-  = Plain
+  , (Just Media, "MEDIA enabled")
-  | Markdown
+  , (Just SocialAuditing, "AUDIT enabled")
-  | Html
+  , (Just BoardOfDirectors, "BOD enabled")
-
+  , (Just SupplyChain, "CHAIN enabled")
-download_mime : DownloadType -> String
+  , (Just Copyleft, "COPYLEFT enabled")
-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)

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")
+  ]

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
+  = SwitchLicense SelectedLicense
-  | Download DownloadType
+  | ToggleModule AnyModule Bool
+  | Download License.DownloadType
 
-add_or_remove : Bool -> (a -> Set a -> Set a)
+type AnyModule
-add_or_remove active =
+  = HippocraticMod Hippocratic.Module
-  if active then
+  | NPLMod NPL.Module
-    Sort.Set.insert
+
-  else
+type alias ModuleWrapper mtype = mtype -> AnyModule
-    Sort.Set.remove
 
 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 : ModuleWrapper moduleType -> (moduleType -> License.ModuleInfo) -> Set moduleType -> moduleType -> Html Msg
-view_module_button enabled mod =
+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) ]
+      , h3 [] [ text (.name (moduleInfo mod)) ]
-      , p [] (module_desc mod)
+      , Html.map never (p [] (.desc (moduleInfo mod)))
       ]
     ]
 
-view_modules : Set Module -> Html Msg
+view_modules : ModuleWrapper moduleType -> License moduleType -> Html Msg
-view_modules modules =
+view_modules wrap license =
   section [id "modules"] (
-      all_modules
+      license.info.availableModules
-        |> List.map (view_module_button modules)
+        |> 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
     ]