diff --git a/dev/Colors.elm b/dev/Colors.elm new file mode 100644 index 0000000..aff1ccc --- /dev/null +++ b/dev/Colors.elm @@ -0,0 +1,497 @@ +module Colors exposing (..) + +{-| This module aims to create color palettes that fit the Noordstar color scheme. +-} + +import Color exposing (rgb255) +import Element +import Element.Background +import Element.Font +import Svg +import Svg.Attributes exposing (fill) +import Widget.Material exposing (Palette) + + +type alias Color = + Color.Color + +type alias AllColors a = + AllBlindnesses (AllModes (AllShades (AllNames a))) + +allColors : AllColors Color +allColors = + allBlindnesses + (\blindness -> + allModes + (\mode -> + allShades + (\shade -> + allNames + (\name -> + get blindness mode shade name + ) + ) + ) + ) + +stdPicker : Picker +stdPicker = + allColors.trichromatic.lightMode + +type Name + = Primary + | Secondary + | Tertiary + | Quaternary + | Extra + | Black + | White + +type alias AllNames a = + { primary : a + , secondary : a + , tertiary : a + , quaternary : a + , extra : a + , black : a + , white : a + } + +allNames : (Name -> a) -> AllNames a +allNames builder = + { primary = builder Primary + , secondary = builder Secondary + , tertiary = builder Tertiary + , quaternary = builder Quaternary + , extra = builder Extra + , black = builder Black + , white = builder White + } + +type Shade + = Light + | Medium + | Dark + +type alias AllShades a = + { light : a + , medium : a + , dark : a + } + +allShades : (Shade -> a) -> AllShades a +allShades builder = + { light = builder Light + , medium = builder Medium + , dark = builder Dark + } + +{-| Based on the user's preferences, the website can be displayed in light mode or dark mode. +-} +type Mode + = LightMode + | DarkMode + +type alias AllModes a = + { lightMode : a + , darkMode : a + } + +allModes : (Mode -> a) -> AllModes a +allModes builder = + { lightMode = builder LightMode + , darkMode = builder DarkMode + } + +{-| The website supports color blindness friendly color palettes. +This way, everyone can enjoy the website's graphs without having to distinguish +colors that they cannot distinguish. +-} +type Blindness + = Trichromatic -- ALL THREE + | Protanomaly -- BARELY RED + | Deuteranomaly -- BARELY GREEN + | Tritanomaly -- BARELY BLUE + | Protanopia -- NO RED + | Deuteranopia -- NO GREEN + | Tritanopia -- NO BLUE + | Monochromacy -- NO COLOR + | BlueConeMonochromacy -- BARELY COLOR + +type alias AllBlindnesses a = + { trichromatic : a + , protanomaly : a + , deuteranomaly : a + , tritanomaly : a + , protanopia : a + , deuteranopia : a + , tritanopia : a + , monochromacy : a + , blueConeMonochromacy : a + } + +allBlindnesses : (Blindness -> a) -> AllBlindnesses a +allBlindnesses builder = + { trichromatic = builder Trichromatic + , protanomaly = builder Protanomaly + , deuteranomaly = builder Deuteranomaly + , tritanomaly = builder Tritanomaly + , protanopia = builder Protanopia + , deuteranopia = builder Deuteranopia + , tritanopia = builder Tritanopia + , monochromacy = builder Monochromacy + , blueConeMonochromacy = builder BlueConeMonochromacy + } + +type alias Picker = + AllShades (AllNames Color) + + +{-| Get a color based on the right criteria. +-} +get : Blindness -> Mode -> Shade -> Name -> Color +get blindness mode shade name = + let + trueName : Name + trueName = + name |> flipName mode + + trueShade : Shade + trueShade = + shade |> flipShade mode + in + toBlindnessPalette blindness + |> toColor blindness trueName + |> fromShade trueShade + |> (\( r, g, b ) -> rgb255 r g b) + + +defaultPalette : Picker -> Palette +defaultPalette p = + { primary = p.medium.primary + , secondary = p.medium.secondary + , background = p.dark.white + , surface = p.light.white + , error = p.light.secondary + , on = + { primary = p.light.white + , secondary = p.light.white + , background = p.light.black + , surface = p.dark.black + , error = p.medium.white + } + } + + +{-| Get a blindness color palette based on a blindness input. +-} +toBlindnessPalette : Blindness -> BlindnessPalette +toBlindnessPalette blindness = + case blindness of + Trichromatic -> + trichromatic + + Protanomaly -> + protanomaly + + Deuteranomaly -> + deuteranomaly + + Tritanomaly -> + tritanomaly + + Protanopia -> + protanopia + + Deuteranopia -> + deuteranopia + + Tritanopia -> + tritanopia + + Monochromacy -> + monochromacy + + BlueConeMonochromacy -> + blueConeMonochromacy + + +flipName : Mode -> Name -> Name +flipName mode name = + case mode of + LightMode -> + name + + DarkMode -> + case name of + Black -> + White + + White -> + Black + + _ -> + name + + +flipShade : Mode -> Shade -> Shade +flipShade mode shade = + case ( mode, shade ) of + ( LightMode, _ ) -> + shade + + ( DarkMode, Dark ) -> + Light + + ( DarkMode, Medium ) -> + Medium + + ( DarkMode, Light ) -> + Dark + + +{-| We distringuish the following colours: + + | Protan | Deuter | Tritan | Mono | + + - Blue | Blue | Blue | Blue | Blue | + - Green | Green | Green | Green | XXXXXX | [Orange] + - Yellow | Yellow | Yellow | XXXXXX | Yellow | [Orange] + - Orange | XXXXXX | XXXXXX | Orange | Orange | [Green,Red] + - Red | Red | Red | Red | Red | + - Black | Black | Black | Black | Black | + - White | White | White | White | White | + +In other words: + +Primary | Blue | Blue | Blue | Blue | +Secondary | Red | Red | Red | Red | +Tertiary | Yellow | Yellow | Orange | Yellow | +Quaternary | Green | Green | Green | Orange | +-----------|--------|--------|--------|--------| +Rest | Orange | Orange | Yellow | Green | + +-} +toColor : Blindness -> Name -> (BlindnessPalette -> ColorPalette) +toColor blindness name = + case name of + Primary -> + .blue + + Secondary -> + .red + + Tertiary -> + case blindness of + Tritanopia -> + .orange + + _ -> + .yellow + + Quaternary -> + case blindness of + Monochromacy -> + .orange + + _ -> + .green + + Extra -> + case blindness of + Tritanopia -> + .yellow + + Monochromacy -> + .green + + _ -> + .orange + + Black -> + .black + + White -> + .white + + +fromShade : Shade -> ColorPalette -> ( Int, Int, Int ) +fromShade shade = + case shade of + Light -> + .light + + Medium -> + .medium + + Dark -> + .dark + + +type alias ColorPalette = + { light : ( Int, Int, Int ) + , medium : ( Int, Int, Int ) + , dark : ( Int, Int, Int ) + } + + +type alias BlindnessPalette = + { blue : ColorPalette + , green : ColorPalette + , yellow : ColorPalette + , orange : ColorPalette + , red : ColorPalette + , black : ColorPalette + , white : ColorPalette + } + + +{-| No color blindness +-} +trichromatic : BlindnessPalette +trichromatic = + { blue = { light = ( 0x42, 0x87, 0xFF ), medium = ( 0x42, 0x7F, 0xF0 ), dark = ( 0x00, 0x54, 0xBD ) } + , green = { light = ( 0x86, 0xEA, 0xD1 ), medium = ( 0x5E, 0xA4, 0x93 ), dark = ( 0x3E, 0x6D, 0x62 ) } + , yellow = { light = ( 0xFC, 0xF9, 0x2B ), medium = ( 0xD2, 0xD0, 0x24 ), dark = ( 0xAF, 0xAD, 0x1E ) } + , orange = { light = ( 0xFF, 0xBB, 0x93 ), medium = ( 0xCC, 0x95, 0x75 ), dark = ( 0xA3, 0x77, 0x5E ) } + , red = { light = ( 0xDC, 0x00, 0x00 ), medium = ( 0xB0, 0x00, 0x00 ), dark = ( 0x8C, 0x00, 0x00 ) } + , black = { light = ( 0x2C, 0x2C, 0x48 ), medium = ( 0x1D, 0x1D, 0x30 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFE, 0xFA, 0xF5 ), dark = ( 0xF2, 0xEF, 0xEA ) } + } + + +{-| Weak red vision +-} +protanomaly : BlindnessPalette +protanomaly = + { blue = { light = ( 0x49, 0x86, 0xFE ), medium = ( 0x46, 0x7E, 0xEF ), dark = ( 0x00, 0x55, 0xB9 ) } + , green = { light = ( 0xBE, 0xDD, 0xCA ), medium = ( 0x85, 0x9B, 0x8E ), dark = ( 0x58, 0x67, 0x5F ) } + , yellow = { light = ( 0xFE, 0xF4, 0x88 ), medium = ( 0xDD, 0xCC, 0x23 ), dark = ( 0xB8, 0xAA, 0x1D ) } + , orange = { light = ( 0xE6, 0xC4, 0x97 ), medium = ( 0xB8, 0x9D, 0x78 ), dark = ( 0x93, 0x7D, 0x61 ) } + , red = { light = ( 0x9F, 0x47, 0x12 ), medium = ( 0x7F, 0x39, 0x0F ), dark = ( 0x65, 0x2D, 0x0C ) } + , black = { light = ( 0x27, 0x2D, 0x49 ), medium = ( 0x1A, 0x1E, 0x31 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFF, 0xFA, 0xF6 ), dark = ( 0xF4, 0xEE, 0xEA ) } + } + + +{-| Weak green vision +-} +deuteranomaly : BlindnessPalette +deuteranomaly = + { blue = { light = ( 0x18, 0x8A, 0xFA ), medium = ( 0x18, 0x82, 0xEC ), dark = ( 0x00, 0x59, 0xA9 ) } + , green = { light = ( 0xC6, 0xD9, 0xD5 ), medium = ( 0x8B, 0x98, 0x95 ), dark = ( 0x5C, 0x65, 0x64 ) } + , yellow = { light = ( 0xFE, 0xF3, 0x9C ), medium = ( 0xEE, 0xC5, 0x2B ), dark = ( 0xC6, 0xA4, 0x23 ) } + , orange = { light = ( 0xF5, 0xBF, 0x92 ), medium = ( 0xC4, 0x99, 0x74 ), dark = ( 0x9D, 0x7A, 0x5D ) } + , red = { light = ( 0xA9, 0x43, 0x00 ), medium = ( 0x87, 0x36, 0x00 ), dark = ( 0x6C, 0x2B, 0x00 ) } + , black = { light = ( 0x26, 0x2E, 0x48 ), medium = ( 0x19, 0x1E, 0x30 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFE, 0xFA, 0xF5 ), dark = ( 0xFA, 0xEC, 0xEC ) } + } + + +{-| Weak blue vision +-} +tritanomaly : BlindnessPalette +tritanomaly = + { blue = { light = ( 0x18, 0x93, 0xC5 ), medium = ( 0x18, 0x8A, 0xBA ), dark = ( 0x00, 0x5E, 0x88 ) } + , green = { light = ( 0x8C, 0xE7, 0xE9 ), medium = ( 0x62, 0xA2, 0xA4 ), dark = ( 0x41, 0x6B, 0x6D ) } + , yellow = { light = ( 0xFE, 0xF1, 0xAC ), medium = ( 0xDA, 0xC7, 0x92 ), dark = ( 0xB6, 0xA5, 0x79 ) } + , orange = { light = ( 0xFF, 0xB8, 0xB2 ), medium = ( 0xCE, 0x92, 0x8D ), dark = ( 0xA5, 0x74, 0x71 ) } + , red = { light = ( 0xDB, 0x0D, 0x00 ), medium = ( 0xAF, 0x0A, 0x00 ), dark = ( 0x8B, 0x08, 0x00 ) } + , black = { light = ( 0x29, 0x2F, 0x3B ), medium = ( 0x1B, 0x1F, 0x27 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFD, 0xFA, 0xFB ), dark = ( 0xF4, 0xED, 0xF7 ) } + } + + +{-| Red-blind vision +-} +protanopia : BlindnessPalette +protanopia = + { blue = { light = ( 0x4D, 0x86, 0xFE ), medium = ( 0x48, 0x7E, 0xEF ), dark = ( 0x00, 0x56, 0xB6 ) } + , green = { light = ( 0xDE, 0xD6, 0xC6 ), medium = ( 0x9C, 0x96, 0x8B ), dark = ( 0x67, 0x64, 0x5D ) } + , yellow = { light = ( 0xFF, 0xF2, 0xBE ), medium = ( 0xE3, 0xCA, 0x22 ), dark = ( 0xBD, 0xA8, 0x1D ) } + , orange = { light = ( 0xD8, 0xCA, 0x9A ), medium = ( 0xAD, 0xA1, 0x7A ), dark = ( 0x8A, 0x81, 0x62 ) } + , red = { light = ( 0x7D, 0x6F, 0x1C ), medium = ( 0x64, 0x59, 0x17 ), dark = ( 0x4F, 0x47, 0x12 ) } + , black = { light = ( 0x24, 0x2E, 0x4A ), medium = ( 0x18, 0x1E, 0x31 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFF, 0xFA, 0xF6 ), dark = ( 0xF5, 0xEE, 0xEA ) } + } + + +{-| Green-blind vision +-} +deuteranopia : BlindnessPalette +deuteranopia = + { blue = { light = ( 0x00, 0x8C, 0xF8 ), medium = ( 0x00, 0x84, 0xEA ), dark = ( 0x00, 0x5B, 0x9D ) } + , green = { light = ( 0xEB, 0xD0, 0xD7 ), medium = ( 0xA5, 0x92, 0x97 ), dark = ( 0x6D, 0x61, 0x65 ) } + , yellow = { light = ( 0xFF, 0xEF, 0xDC ), medium = ( 0xFE, 0xBF, 0x2E ), dark = ( 0xD3, 0x9F, 0x26 ) } + , orange = { light = ( 0xF0, 0xC2, 0x92 ), medium = ( 0xBF, 0x9B, 0x74 ), dark = ( 0x99, 0x7B, 0x5D ) } + , red = { light = ( 0x8C, 0x69, 0x00 ), medium = ( 0x70, 0x54, 0x00 ), dark = ( 0x59, 0x43, 0x00 ) } + , black = { light = ( 0x23, 0x2F, 0x47 ), medium = ( 0x16, 0x1F, 0x30 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFF, 0xF9, 0xFA ), dark = ( 0xFF, 0xEA, 0xED ) } + } + + +{-| Blue-blind vision +-} +tritanopia : BlindnessPalette +tritanopia = + { blue = { light = ( 0x00, 0x99, 0xA4 ), medium = ( 0x00, 0x90, 0x9B ), dark = ( 0x00, 0x63, 0x69 ) } + , green = { light = ( 0x90, 0xE5, 0xF7 ), medium = ( 0x65, 0xA0, 0xAD ), dark = ( 0x43, 0x6B, 0x73 ) } + , yellow = { light = ( 0xFF, 0xED, 0xF6 ), medium = ( 0xDF, 0xC2, 0xD1 ), dark = ( 0xBA, 0xA1, 0xAE ) } + , orange = { light = ( 0xFF, 0xB7, 0xC3 ), medium = ( 0xCF, 0x90, 0x9B ), dark = ( 0xA6, 0x73, 0x7C ) } + , red = { light = ( 0xDA, 0x14, 0x00 ), medium = ( 0xAF, 0x10, 0x00 ), dark = ( 0x8B, 0x0D, 0x00 ) } + , black = { light = ( 0x27, 0x30, 0x34 ), medium = ( 0x1A, 0x20, 0x22 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFC, 0xFA, 0xFF ), dark = ( 0xF5, 0xEC, 0xFE ) } + } + + +{-| Color-less vision +-} +monochromacy : BlindnessPalette +monochromacy = + { blue = { light = ( 0x80, 0x80, 0x80 ), medium = ( 0x7A, 0x7A, 0x7A ), dark = ( 0x47, 0x47, 0x47 ) } + , green = { light = ( 0xC9, 0xC9, 0xC9 ), medium = ( 0x8D, 0x8D, 0x8D ), dark = ( 0x5E, 0x5E, 0x5E ) } + , yellow = { light = ( 0xE2, 0xE2, 0xE2 ), medium = ( 0xBD, 0xBD, 0xBD ), dark = ( 0x9D, 0x9D, 0x9D ) } + , orange = { light = ( 0xCB, 0xCB, 0xCB ), medium = ( 0xA2, 0xA2, 0xA2 ), dark = ( 0x81, 0x81, 0x81 ) } + , red = { light = ( 0x42, 0x42, 0x42 ), medium = ( 0x35, 0x35, 0x35 ), dark = ( 0x2A, 0x2A, 0x2A ) } + , black = { light = ( 0x2F, 0x2F, 0x2F ), medium = ( 0x1F, 0x1F, 0x1F ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFB, 0xFB, 0xFB ), dark = ( 0xEF, 0xEF, 0xEF ) } + } + + +{-| Blue cone monochromacy +-} +blueConeMonochromacy : BlindnessPalette +blueConeMonochromacy = + { blue = { light = ( 0x69, 0x83, 0xAE ), medium = ( 0x66, 0x7C, 0xA5 ), dark = ( 0x2D, 0x4C, 0x72 ) } + , green = { light = ( 0xB1, 0xD5, 0xCC ), medium = ( 0x7C, 0x95, 0x8F ), dark = ( 0x52, 0x63, 0x5F ) } + , yellow = { light = ( 0xEB, 0xEA, 0x9F ), medium = ( 0xC5, 0xC4, 0x85 ), dark = ( 0xA4, 0xA3, 0x6F ) } + , orange = { light = ( 0xDE, 0xC5, 0xB7 ), medium = ( 0xB1, 0x9D, 0x92 ), dark = ( 0x8D, 0x7D, 0x74 ) } + , red = { light = ( 0x7A, 0x2A, 0x2A ), medium = ( 0x62, 0x22, 0x22 ), dark = ( 0x4E, 0x1B, 0x1B ) } + , black = { light = ( 0x2E, 0x2E, 0x38 ), medium = ( 0x1E, 0x1E, 0x25 ), dark = ( 0x00, 0x00, 0x00 ) } + , white = { light = ( 0xFF, 0xFF, 0xFF ), medium = ( 0xFC, 0xFB, 0xF9 ), dark = ( 0xF0, 0xEF, 0xED ) } + } + + +svgFill : Color -> Svg.Attribute msg +svgFill = + Color.toCssString >> fill + + +svgStroke : Color -> Svg.Attribute msg +svgStroke = + Color.toCssString >> Svg.Attributes.stroke + + +font : Color -> Element.Attribute msg +font = + Color.toRgba >> Element.fromRgb >> Element.Font.color + + +background : Color -> Element.Attribute msg +background = + Color.toRgba >> Element.fromRgb >> Element.Background.color + + +transparent : Color +transparent = + Color.rgba 0 0 0 0 diff --git a/dev/DocsDisplay.elm b/dev/DocsDisplay.elm new file mode 100644 index 0000000..d625134 --- /dev/null +++ b/dev/DocsDisplay.elm @@ -0,0 +1,251 @@ +module DocsDisplay exposing (..) + +import Internal.Tools.Json as Json exposing (Docs(..)) +import Element exposing (Element) +import Element.Font as Font +import Widget +import Widget.Material as Material +import Widget.Material.Typography as Typography +import Colors as C +import Internal.Tools.Json as Json +import Internal.Tools.Json as Json +import Internal.Tools.Json as Json +import FastDict as Dict exposing (Dict) + +type alias DObject = + { name : String + , description : List String + , keys : + List + { field : String + , description : List String + , required : Json.RequiredField + , content : Docs + } + } + +render : Dict String Bool -> Docs -> Element (String, Bool) +render dict docs = + docs + |> findObjects + |> List.map + (\dobject -> + Element.column [] + [ Element.el Typography.h3 + ( Element.text dobject.name ) + , dobject.description + |> List.map (Element.text >> List.singleton >> Element.paragraph []) + |> Element.column [] + , toTable (Dict.get dobject.name dict |> Maybe.withDefault True) dobject + |> Element.map (Tuple.pair dobject.name) + ] + ) + |> List.append + [ Element.paragraph [] + [ Element.text "This coder decodes to " + , Element.el + [ Font.family [ Font.monospace ] + , C.background C.stdPicker.medium.white + ] + ( Element.text <| toString docs ) + ] + ] + |> Element.column [] + +findObjects : Docs -> List DObject +findObjects docs = + bfs [ docs ] [] + +bfs : List Docs -> List DObject -> List DObject +bfs queue acc = + case queue of + [] -> + acc + + head :: tail -> + case head of + DocsBool -> + bfs tail acc + + DocsDict d -> + bfs (d :: tail) acc + + DocsFloat -> + bfs tail acc + + DocsInt -> + bfs tail acc + + DocsLazy f -> + bfs (f () :: tail) acc + + DocsList d -> + bfs (d :: tail) acc + + DocsMap { content } -> + bfs (content :: tail) acc + + DocsObject dobject -> + if List.any (\item -> item.name == dobject.name) acc then + bfs tail acc + else + bfs + (List.append tail (List.map .content dobject.keys)) + (List.append acc [ dobject ]) + + DocsOptional d -> + bfs (d :: tail) acc + + DocsRiskyMap { content } -> + bfs (content :: tail) acc + + DocsString -> + bfs tail acc + + DocsValue -> + bfs tail acc + +toTable : Bool -> DObject -> Element Bool +toTable asc dobject = + Widget.sortTableV2 (Material.sortTable <| C.defaultPalette C.stdPicker) + { content = dobject.keys + , columns = + [ Widget.stringColumnV2 + { title = "Field" + , value = .field + , toString = identity + , width = Element.fillPortion 1 + } + , Widget.customColumnV2 + { title = "Type" + , value = + (\item -> + item.content + |> toString + |> Element.text + |> Element.el + [ Font.family [Font.monospace] + , C.background C.stdPicker.dark.white + , Element.padding 3 + , Element.centerX + ] + ) + , width = Element.fillPortion 1 + } + , Widget.customColumnV2 + { title = "Description" + , value = showDescription + , width = Element.fillPortion 5 + } + ] + , asc = asc + , sortBy = "Field" + , onChange = + (\f -> + if f == "Field" then + not asc + else + asc + ) + } + +{-| Show the description of a field in a table column. +-} +showDescription : { a | description : List String, required : Json.RequiredField } -> Element msg +showDescription { description, required } = + case description of + [] -> + Element.column [] + [ Element.paragraph [] + [ "WARNING: " + |> Element.text + |> Element.el [ Font.bold ] + , "This field has no documentation yet!" + |> Element.text + ] + , case required of + Json.RequiredField -> + Element.paragraph [] + [ "This field is required." + |> Element.text + ] + + Json.OptionalField -> + Element.paragraph [] + [ "This field is optional." + |> Element.text + ] + + Json.OptionalFieldWithDefault default -> + Element.paragraph [] + [ "This field is optional. If it is not there, a default value of \"" ++ default ++ "\" will be taken." + |> Element.text + ] + ] + + head :: tail -> + case required of + Json.RequiredField -> + ( Element.paragraph [] + [ Element.el [ Font.bold ] (Element.text "Required: ") + , Element.text head + ] + ) + :: + ( List.map (Element.text >> List.singleton >> Element.paragraph []) tail) + |> Element.column [] + + Json.OptionalField -> + description + |> List.map (Element.text >> List.singleton >> Element.paragraph []) + |> Element.column [] + + Json.OptionalFieldWithDefault default -> + Element.paragraph [] + [ Element.el [ Font.bold] (Element.text "Defaults to: ") + , Element.text default + ] + |> List.singleton + |> List.append (List.map (Element.text >> List.singleton >> Element.paragraph []) description) + |> Element.column [] + +{-| Write JSON type as a string. +-} +toString : Docs -> String +toString docs = + case docs of + DocsBool -> + "bool" + + DocsDict d -> + "{string:" ++ (toString d) ++ "}" + + DocsFloat -> + "float" + + DocsInt -> + "int" + + DocsLazy f -> + toString (f ()) + + DocsList d -> + "[" ++ (toString d) ++ "]" + + DocsMap { content } -> + "f(" ++ (toString content) ++ ")" + + DocsObject { name } -> + name + + DocsOptional d -> + toString d + + DocsRiskyMap { content } -> + "f(" ++ (toString content) ++ ")" + + DocsString -> + "string" + + DocsValue -> + "" diff --git a/dev/Main.elm b/dev/Main.elm new file mode 100644 index 0000000..49491c0 --- /dev/null +++ b/dev/Main.elm @@ -0,0 +1,100 @@ +module Main exposing (main) + +{-| This module creates a browser document that allows users to look at various +documentation elements of the Elm Matrix SDK. +-} + +import Browser +import Browser.Navigation as Navigation +import Route exposing (Route(..)) +import Url +import FastDict as Dict +import DocsDisplay as Display +import Internal.Values.StateManager +import Element +import Internal.Tools.Json as Json + + +main : Program () Model Msg +main = + Browser.application + { init = init + , view = view + , update = update + , subscriptions = subscriptions + , onUrlChange = OnUrlChange + , onUrlRequest = OnUrlRequest + } + + +type alias Model = + { key : Navigation.Key + , page : Route.Route + } + + +type Msg + = OnTableSwitch ( String, Bool ) + | OnUrlChange Url.Url + | OnUrlRequest Browser.UrlRequest + + + +-- INIT + + +init : () -> Url.Url -> Navigation.Key -> ( Model, Cmd Msg ) +init () url key = + ( { key = key + , page = Route.toRoute url + } + , Cmd.none + ) + + + +-- UPDATE + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + OnTableSwitch _ -> + ( model, Cmd.none ) + + OnUrlChange url -> + init () url model.key + + OnUrlRequest (Browser.Internal url) -> + ( model, Navigation.pushUrl model.key (Url.toString url) ) + + OnUrlRequest (Browser.External url) -> + ( model, Navigation.load url ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + + +-- VIEW + + +view : Model -> Browser.Document Msg +view model = + { title = Route.toString model.page ++ " | Elm Matrix SDK Docs" + , body = + case model.page of + _ -> + Internal.Values.StateManager.coder + |> Json.toDocs + |> Display.render Dict.empty + |> Element.map OnTableSwitch + |> Element.layout [] + |> List.singleton + } diff --git a/dev/Route.elm b/dev/Route.elm new file mode 100644 index 0000000..06fed1a --- /dev/null +++ b/dev/Route.elm @@ -0,0 +1,52 @@ +module Route exposing (..) + +{-| This module helps parse the URL route into explicable data. +-} + +import Url +import Url.Parser as P exposing (()) + + +type Route + = Home + | NotFound + | ViewObject String + + +toRoute : Url.Url -> Route +toRoute url = + P.parse routeParser url |> Maybe.withDefault NotFound + + +toString : Route -> String +toString route = + case route of + Home -> + "Home" + + NotFound -> + "404" + + ViewObject o -> + o + + +routeParser : P.Parser (Route -> a) a +routeParser = + P.oneOf + [ P.top + |> P.map Home + , P.s "home" + |> P.map Home + , P.s "index" + |> P.map Home + , P.s "dev" + (P.s "Main.elm") + |> P.map Home + , P.s "object" + P.string + |> P.map ViewObject + , P.s "object" + P.top + |> P.map (ViewObject "") + ] diff --git a/elm-dev.json b/elm-dev.json new file mode 100644 index 0000000..5a258c9 --- /dev/null +++ b/elm-dev.json @@ -0,0 +1,40 @@ +{ + "type": "application", + "source-directories": [ + "src", + "dev" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "Orasund/elm-ui-widgets": "3.4.0", + "avh4/elm-color": "1.0.0", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "mdgriffith/elm-ui": "1.1.8", + "miniBill/elm-fast-dict": "1.1.0" + }, + "indirect": { + "elm/regex": "1.0.0", + "elm/virtual-dom": "1.0.3", + "elm-community/intdict": "3.0.0", + "fredcy/elm-parseint": "2.0.1", + "noahzgordon/elm-color-extra": "1.0.2", + "turboMaCk/queue": "1.1.0" + } + }, + "test-dependencies": { + "direct": { + "elm-explorations/test": "2.2.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/random": "1.0.0" + } + } +} diff --git a/tests/Dev/Route.elm b/tests/Dev/Route.elm new file mode 100644 index 0000000..944a46f --- /dev/null +++ b/tests/Dev/Route.elm @@ -0,0 +1,87 @@ +module Dev.Route exposing (..) + +{-| This module tests whether routes are translated correctly. +-} + +import Expect +import Fuzz exposing (Fuzzer) +import Route exposing (Route(..), toRoute) +import Test exposing (..) +import Url + + +customPath : String -> Fuzzer Url.Url +customPath path = + Fuzz.map (\url -> { url | path = path }) fuzzer + + + +-- TODO: Create a more valid URL fuzzer + + +fuzzer : Fuzzer Url.Url +fuzzer = + Fuzz.map6 Url.Url + (Fuzz.oneOfValues [ Url.Http, Url.Https ]) + Fuzz.string + (Fuzz.maybe Fuzz.int) + Fuzz.string + (Fuzz.maybe Fuzz.string) + (Fuzz.maybe Fuzz.string) + + + +-- urlCheck : Test +-- urlCheck = +-- describe "URL fuzzer tests" +-- [ fuzz fuzzer"Index always parses to url" +-- (\url -> +-- url +-- |> Url.toString +-- |> Url.fromString +-- |> Expect.equal (Just url) +-- ) +-- ] + + +suite : Test +suite = + describe "Route conversion" + [ fuzz (customPath "/") + "/ --> Home" + (\url -> + url + |> toRoute + |> Expect.equal Home + ) + , fuzz (customPath "/home") + "/home --> Home" + (\url -> + url + |> toRoute + |> Expect.equal Home + ) + , fuzz (customPath "/index") + "/index --> Home" + (\url -> + url + |> toRoute + |> Expect.equal Home + ) + , fuzz + (Fuzz.asciiString + |> Fuzz.filter (not << String.contains "/") + |> Fuzz.andThen + (\o -> + Fuzz.pair + (Fuzz.constant o) + (customPath ("/object/" ++ o)) + ) + ) + "Object can be seen" + (\( o, url ) -> + url + |> toRoute + |> Expect.equal (ViewObject o) + ) + ]