diff --git a/browser/assets/favicon.ico b/browser/assets/favicon.ico new file mode 100644 index 00000000..41edb810 Binary files /dev/null and b/browser/assets/favicon.ico differ diff --git a/browser/assets/source-code-pro.ttf b/browser/assets/source-code-pro.ttf new file mode 100644 index 00000000..268a2e43 Binary files /dev/null and b/browser/assets/source-code-pro.ttf differ diff --git a/browser/assets/source-sans-pro.ttf b/browser/assets/source-sans-pro.ttf new file mode 100644 index 00000000..950ff8bd Binary files /dev/null and b/browser/assets/source-sans-pro.ttf differ diff --git a/browser/assets/styles.css b/browser/assets/styles.css new file mode 100644 index 00000000..d85833f3 --- /dev/null +++ b/browser/assets/styles.css @@ -0,0 +1,246 @@ +@charset "UTF-8"; + + +/* FONTS */ + +@font-face { + font-family: 'Source Code Pro'; + font-style: normal; + font-weight: 400; + src: local('Source Code Pro'), local('SourceCodePro-Regular'), url(/_elm/source-code-pro.ttf) format('truetype'); +} + +@font-face { + font-family: 'Source Sans Pro'; + font-style: normal; + font-weight: 400; + src: local('Source Sans Pro'), local('SourceSansPro-Regular'), url(/_elm/source-sans-pro.ttf) format('truetype'); +} + + +/* GENERIC STUFF */ + +html, head, body { + margin: 0; + height: 100%; +} + +body { + font-family: 'Source Sans Pro', 'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif; + color: #293c4b; +} + +a { + color: #60B5CC; + text-decoration: none; +} + +a:hover { + text-decoration: underline; +} + + +/* INDEX */ + +.header { + width: 100%; + background-color: #60B5CC; + height: 8px; +} + +.content { + width: 960px; + margin-left: auto; + margin-right: auto; +} + + +/* COLUMNS */ + +.left-column { + float: left; + width: 600px; + padding-bottom: 80px; +} + +.right-column { + float: right; + width: 300px; + padding-bottom: 80px; +} + + +/* BOXES */ + +.box { + border: 1px solid #c7c7c7; + border-radius: 5px; + margin-bottom: 40px; +} + +.box-header { + display: block; + overflow: hidden; + padding: 7px 12px; + background-color: #fafafa; + text-align: center; +} + +.box-item { + display: block; + overflow: hidden; + padding: 7px 12px; + border-top: 1px solid #e1e1e1; +} + +.box-footer { + display: block; + overflow: hidden; + padding: 2px 12px; + border-top: 1px solid #e1e1e1; + text-align: center; + background-color: #fafafa; + height: 16px; +} + + +/* ICONS */ + +.icon { + display: inline-block; + vertical-align: middle; + padding-right: 0.5em; +} + + +/* PAGES */ + +.page-name { + float: left; +} + +.page-size { + float: right; + color: #293c4b; +} + +.page-size:hover { + color: #60B5CC; +} + + +/* START */ + +.start { + width: 500px; + margin-left: auto; + margin-right: auto; +} + +.start code { + font-family: 'Source Code Pro', monospace; + padding: 0; + padding-top: 0.2em; + padding-bottom: 0.2em; + margin: 0; + font-size: 85%; + background-color: rgba(0,0,0,0.04); + border-radius: 3px; +} + +.start code::before, .start code::after { + letter-spacing: -0.2em; + content: "\00a0"; +} + + +/* START HELLO */ + +.start-hello { + text-align: center; + padding: calc(50vh - 180px) 0; +} + +.start-hello h1 { + font-size: 5em; + margin: 0; +} + + +/* START DETAILS */ + +.start-details { + background: rgb(233, 235, 235); + border-top-left-radius: 10px; + border-top-right-radius: 10px; + padding: 1em 2em; +} + +.start-details h2 { + text-align: center; +} + +.start-details li { + padding-bottom: 0.5em; +} + + +/* WAITING */ + +.waiting { + width: 100%; + height: 100%; + display: flex; + flex-direction: column; + justify-content: center; + align-items: center; + color: #9A9A9A; +} + + +/* NOT FOUND */ + +.not-found { + width: 100%; + height: 100%; + display: flex; + flex-direction: column; + justify-content: center; + align-items: center; + background-color: #F5F5F5; + color: #9A9A9A; +} + + + +/* BUTTONS */ + +.button { + text-align: center; +} + +.button a { + background-color: #7FD13B; + border-radius: 6px; + min-width: 120px; + padding: 12px 24px; + margin: 12px; + display: inline-block; + color: white; + font-size: 1.5em; + cursor: pointer; +} + +.button a:hover { + color: white; + background-color: #62BC17; + text-decoration: none; +} + + +/* POTENTIAL */ + +.potential h1 { + padding-top: 1em; + font-size: 3em; +} \ No newline at end of file diff --git a/browser/assets/waiting.gif b/browser/assets/waiting.gif new file mode 100644 index 00000000..eadcf442 Binary files /dev/null and b/browser/assets/waiting.gif differ diff --git a/browser/check.py b/browser/check.py new file mode 100755 index 00000000..9aced8b2 --- /dev/null +++ b/browser/check.py @@ -0,0 +1,48 @@ +#!/usr/bin/env python + +import os +import sys + + +## FIGURE OUT NEW MODIFICATION TIME + +def mostRecentModification(directory): + mostRecent = 0 + + for dirpath, dirs, files in os.walk(directory): + for f in files: + lastModified = os.path.getmtime(dirpath + '/' + f) + mostRecent = max(int(lastModified), mostRecent) + + return mostRecent + + +srcTime = mostRecentModification('ui/src') +assetTime = mostRecentModification('ui/assets') +mostRecent = max(srcTime, assetTime) + + +## FIGURE OUT OLD MODIFICATION TIME + +with open('ui/last-modified', 'a') as handle: + pass + + +prevMostRecent = 0 + + +with open('ui/last-modified', 'r+') as handle: + line = handle.read() + prevMostRecent = int(line) if line else 0 + + +## TOUCH FILES IF NECESSARY + +if mostRecent > prevMostRecent: + print "+------------------------------------------------------------+" + print "| Some ui/ code changed. Touching src/Reactor/StaticFiles.hs |" + print "| to trigger a recompilation of the Template Haskell stuff. |" + print "+------------------------------------------------------------+" + os.utime('src/Reactor/StaticFiles.hs', None) + with open('ui/last-modified', 'w') as handle: + handle.write(str(mostRecent)) diff --git a/browser/elm.json b/browser/elm.json new file mode 100644 index 00000000..ab7c26ff --- /dev/null +++ b/browser/elm.json @@ -0,0 +1,22 @@ +{ + "type": "browser", + "source-directories": [ + "src" + ], + "elm-version": "0.19.0", + "dependencies": { + "elm-explorations/markdown": "1.0.0", + "elm-lang/core": "6.0.0", + "elm-lang/html": "3.0.0", + "elm-lang/http": "2.0.0", + "elm-lang/json": "1.0.0", + "elm-lang/project-metadata-utils": "1.0.0", + "elm-lang/svg": "3.0.0" + }, + "test-dependencies": {}, + "do-not-edit-this-by-hand": { + "transitive-dependencies": { + "elm-lang/virtual-dom": "3.0.0" + } + } +} \ No newline at end of file diff --git a/browser/src/Errors.elm b/browser/src/Errors.elm new file mode 100644 index 00000000..4801c2aa --- /dev/null +++ b/browser/src/Errors.elm @@ -0,0 +1,145 @@ +module Errors exposing (main) + +import Char +import Html exposing (..) +import Html.Attributes exposing (..) +import String + + + +main = + Html.programWithFlags + { init = init + , update = update + , view = view + , subscriptions = always Sub.none + } + + + +-- MODEL + + +type alias Model = + String + + +init : String -> (Model, Cmd msg) +init errorMessage = + (errorMessage, Cmd.none) + + + +-- UPDATE + + +update : msg -> Model -> (Model, Cmd msg) +update _ model = + (model, Cmd.none) + + + +-- VIEW + + +view : Model -> Html msg +view model = + div + [ style "width" "100%" + , style "min-height" "100%" + , style "display" "flex" + , style "flex-direction" "column" + , style "align-items" "center" + , style "background-color" "black" + , style "color" "rgb(233, 235, 235)" + , style "font-family" "monospace" + ] + [ div + [ style "display" "block" + , style "white-space" "pre" + , style "background-color" "rgb(39, 40, 34)" + , style "padding" "2em" + ] + (addColors model) + ] + + +addColors : String -> List (Html msg) +addColors message = + message + |> String.lines + |> List.concatMap addColorToLine + + +addColorToLine : String -> List (Html msg) +addColorToLine line = + flip (++) [ text "\n" ] <| + if isBreaker line then + [ colorful "rgb(51, 187, 200)" ("\n\n" ++ line) ] + + else if isBigBreaker line then + [ colorful "rgb(211, 56, 211)" line ] + + else if isUnderline line then + [ colorful "#D5200C" line ] + + else if String.startsWith " " line then + [ colorful "#9A9A9A" line ] + + else + processLine line + + +colorful : String -> String -> Html msg +colorful color msg = + span [ style "color" color ] [ text msg ] + + +isBreaker : String -> Bool +isBreaker line = + String.startsWith "-- " line + && + String.contains "----------" line + + +isBigBreaker : String -> Bool +isBigBreaker line = + String.startsWith "===============" line + + +isUnderline : String -> Bool +isUnderline line = + String.all (\c -> c == ' ' || c == '^') line + + +isLineNumber : String -> Bool +isLineNumber string = + String.all (\c -> c == ' ' || Char.isDigit c) string + + +processLine : String -> List (Html msg) +processLine line = + case String.split "|" line of + [] -> + [ text line ] + + starter :: rest -> + if not (isLineNumber starter) then + [ text line ] + + else + let + restOfLine = + String.join "|" rest + + marker = + if String.left 1 restOfLine == ">" then + colorful "#D5200C" ">" + + else + text " " + in + [ colorful "#9A9A9A" (starter ++ "|") + , marker + , colorful "#9A9A9A" (String.dropLeft 1 restOfLine) + ] \ No newline at end of file diff --git a/browser/src/Index.elm b/browser/src/Index.elm new file mode 100644 index 00000000..bb13bd36 --- /dev/null +++ b/browser/src/Index.elm @@ -0,0 +1,69 @@ +module Index exposing (main) + +import Html exposing (Html) +import Json.Decode as Decode + +import Index.Dashboard as Dashboard +import Index.Project as Project exposing (Project) + + + +-- MAIN + + +main = + Html.programWithFlags + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + Project + + + +-- INIT + + +init : Decode.Value -> (Model, Cmd msg) +init flags = + case Project.decode flags of + Err _ -> + Debug.crash "TODO" + + Ok project -> + (project, Cmd.none) + + + +-- UPDATE + + +update : msg -> Model -> (Model, Cmd msg) +update _ model = + (model, Cmd.none) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub msg +subscriptions model = + Sub.none + + + +-- VIEW + + +view : Model -> Html msg +view = + Dashboard.view diff --git a/browser/src/Index/Dashboard.elm b/browser/src/Index/Dashboard.elm new file mode 100644 index 00000000..43b491ab --- /dev/null +++ b/browser/src/Index/Dashboard.elm @@ -0,0 +1,228 @@ +module Index.Dashboard exposing + ( view + ) + + +import Html exposing (..) +import Html.Attributes exposing (class, href, style, title) + +import Elm.Config as Config exposing (Config) +import Elm.License as License +import Elm.Repo as Repo exposing (Repo) +import Elm.Version as Version exposing (Version) +import Index.Icon as Icon +import Index.Navigator as Navigator exposing (()) +import Index.Project as Project exposing (Project, File(..)) +import Index.Skeleton as Skeleton + + + +-- VIEW + + +view : Project -> Html msg +view { root, pwd, dirs, files, readme, config } = + Skeleton.view + [ Navigator.view root pwd + , viewLeftColumn dirs files readme + , viewRightColumn config + , clearfix + ] + + +clearfix : Html msg +clearfix = + div [ style "clear" "both" ] [] + + + +-- VIEW LEFT COLUMN + + +viewLeftColumn : List String -> List File -> Maybe String -> Html msg +viewLeftColumn dirs files readme = + section [ class "left-column" ] + [ viewFiles dirs files + , viewReadme readme + ] + + + +-- VIEW README + + +viewReadme : Maybe String -> Html msg +viewReadme readme = + case readme of + Nothing -> + text "" + + Just markdown -> + Skeleton.readmeBox markdown + + + +-- VIEW FILES + + +viewFiles : List String -> List File -> Html msg +viewFiles dirs files = + Skeleton.box + { title = "File Navigation" + , items = List.map viewDir dirs ++ List.map viewFile files + , footer = Nothing + } + + +viewDir : String -> List (Html msg) +viewDir dir = + [ a [ href dir ] [ Icon.folder, text dir ] + ] + + +viewFile : File -> List (Html msg) +viewFile file = + case file of + HasMain name -> + [ a [ href name ] [ Icon.lookup name, text name ] + ] + + NoMain name -> + [ a [ href name ] [ Icon.lookup name, text name ] + ] + + Other name -> + [ a [ href name ] [ Icon.lookup name, text name ] + ] + + + +-- VIEW RIGHT COLUMN + + +viewRightColumn : Config -> Html msg +viewRightColumn config = + div [ class "right-column" ] <| + case config of + Config.App info -> + [ viewPageSummary info.pages + , viewDeps info.dependencies + , viewTestDeps info.testDependencies + ] + + Config.Pkg info -> + [ viewPackageSummary info + , viewDeps (exactify info.dependencies) + , viewTestDeps (exactify info.testDependencies) + ] + + + +-- VIEW PAGE SUMMARY + + +viewPageSummary : List String -> Html msg +viewPageSummary pages = + Skeleton.box + { title = "Pages" + , items = List.map viewPage pages + , footer = Nothing + } + + +viewPage : String -> List (Html msg) +viewPage name = + [ div + [ style "float" "left" + ] + [ Icon.gift + , text name + ] + , div + [ style "float" "right" + ] + [ text "7kb" + , bundleSize 10 + ] + ] + + +bundleSize : Int -> Html msg +bundleSize size = + span + [ style "color" "#e1e1e1" + ] + [ text (" + " ++ String.fromInt size ++ "kb") + ] + + + +-- VIEW PACKAGE SUMMARY + + +viewPackageSummary : Config.PkgInfo -> Html msg +viewPackageSummary { summary, license, version } = + Skeleton.box + { title = "Package Information" + , items = + [ [ text ("Version: " ++ Version.toString version) ] + , [ text ("License: " ++ license.code) ] + ] + , footer = Nothing + } + + + +-- VIEW DEPENDENCIES + + +viewDeps : Config.Deps Version -> Html msg +viewDeps deps = + Skeleton.box + { title = "Dependencies" + , items = List.map viewDep deps + , footer = + Just + ( "/_elm/dependencies" + , "Add more dependencies?" + ) + } + + +viewTestDeps : Config.Deps Version -> Html msg +viewTestDeps deps = + Skeleton.box + { title = "Test Dependencies" + , items = List.map viewDep deps + , footer = + Just + ( "/_elm/test-dependencies" + , "Add more test dependencies?" + ) + } + + +viewDep : (Repo, Version) -> List (Html msg) +viewDep (repo, version) = + [ div + [ style "float" "left" ] + [ Icon.package + , a [ href (toPackageUrl repo version) ] [ text (Repo.toString repo) ] + ] + , div + [ style "float" "right" ] + [ text (Version.toString version) ] + ] + + +toPackageUrl : Repo -> Version -> String +toPackageUrl name version = + "http://package.elm-lang.org/packages" + Repo.toString name + Version.toString version + + +-- TODO - make this actually work! +exactify : Config.Deps a -> Config.Deps Version +exactify deps = + List.map (\(name, _) -> (name, Version 0 0 0)) deps diff --git a/browser/src/Index/Icon.elm b/browser/src/Index/Icon.elm new file mode 100644 index 00000000..0e5296ad --- /dev/null +++ b/browser/src/Index/Icon.elm @@ -0,0 +1,112 @@ +module Index.Icon exposing + ( home + , image + , file + , gift + , folder + , package + , plus + , lookup + ) + +import Dict +import Html exposing (Html) +import Html.Attributes exposing (class) +import Svg exposing (..) +import Svg.Attributes exposing (width, height, viewBox, d, fill) + + + +-- ICON + + +icon : String -> String -> String -> Html msg +icon color size path = + svg + [ class "icon" + , width size + , height size + , viewBox "0 0 1792 1792" + ] + [ path [ fill color, d path ] [] + ] + + + +-- NECESSARY ICONS + + +home : Html msg +home = + icon "#babdb6" "36px" "M1472 992v480q0 26-19 45t-45 19h-384v-384h-256v384h-384q-26 0-45-19t-19-45v-480q0-1 .5-3t.5-3l575-474 575 474q1 2 1 6zm223-69l-62 74q-8 9-21 11h-3q-13 0-21-7l-692-577-692 577q-12 8-24 7-13-2-21-11l-62-74q-8-10-7-23.5t11-21.5l719-599q32-26 76-26t76 26l244 204v-195q0-14 9-23t23-9h192q14 0 23 9t9 23v408l219 182q10 8 11 21.5t-7 23.5z" + + +image : Html msg +image = + icon "#babdb6" "16px" "M1596 380q28 28 48 76t20 88v1152q0 40-28 68t-68 28h-1344q-40 0-68-28t-28-68v-1600q0-40 28-68t68-28h896q40 0 88 20t76 48zm-444-244v376h376q-10-29-22-41l-313-313q-12-12-41-22zm384 1528v-1024h-416q-40 0-68-28t-28-68v-416h-768v1536h1280zm-128-448v320h-1024v-192l192-192 128 128 384-384zm-832-192q-80 0-136-56t-56-136 56-136 136-56 136 56 56 136-56 136-136 56z" + + +file : Html msg +file = + icon "#babdb6" "16px" "M1596 380q28 28 48 76t20 88v1152q0 40-28 68t-68 28h-1344q-40 0-68-28t-28-68v-1600q0-40 28-68t68-28h896q40 0 88 20t76 48zm-444-244v376h376q-10-29-22-41l-313-313q-12-12-41-22zm384 1528v-1024h-416q-40 0-68-28t-28-68v-416h-768v1536h1280zm-1024-864q0-14 9-23t23-9h704q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64zm736 224q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h704zm0 256q14 0 23 9t9 23v64q0 14-9 23t-23 9h-704q-14 0-23-9t-9-23v-64q0-14 9-23t23-9h704z" + + +gift : Html msg +gift = + icon "#babdb6" "16px" "M1056 1356v-716h-320v716q0 25 18 38.5t46 13.5h192q28 0 46-13.5t18-38.5zm-456-844h195l-126-161q-26-31-69-31-40 0-68 28t-28 68 28 68 68 28zm688-96q0-40-28-68t-68-28q-43 0-69 31l-125 161h194q40 0 68-28t28-68zm376 256v320q0 14-9 23t-23 9h-96v416q0 40-28 68t-68 28h-1088q-40 0-68-28t-28-68v-416h-96q-14 0-23-9t-9-23v-320q0-14 9-23t23-9h440q-93 0-158.5-65.5t-65.5-158.5 65.5-158.5 158.5-65.5q107 0 168 77l128 165 128-165q61-77 168-77 93 0 158.5 65.5t65.5 158.5-65.5 158.5-158.5 65.5h440q14 0 23 9t9 23z" + + +folder : Html msg +folder = + icon "#babdb6" "16px" "M1728 608v704q0 92-66 158t-158 66h-1216q-92 0-158-66t-66-158v-960q0-92 66-158t158-66h320q92 0 158 66t66 158v32h672q92 0 158 66t66 158z" + + +package : Html msg +package = + icon "#babdb6" "16px" "M1088 832q0-26-19-45t-45-19h-256q-26 0-45 19t-19 45 19 45 45 19h256q26 0 45-19t19-45zm576-192v960q0 26-19 45t-45 19h-1408q-26 0-45-19t-19-45v-960q0-26 19-45t45-19h1408q26 0 45 19t19 45zm64-448v256q0 26-19 45t-45 19h-1536q-26 0-45-19t-19-45v-256q0-26 19-45t45-19h1536q26 0 45 19t19 45z" + + +plus : Html msg +plus = + icon "#babdb6" "16px" "M1600 736v192q0 40-28 68t-68 28h-416v416q0 40-28 68t-68 28h-192q-40 0-68-28t-28-68v-416h-416q-40 0-68-28t-28-68v-192q0-40 28-68t68-28h416v-416q0-40 28-68t68-28h192q40 0 68 28t28 68v416h416q40 0 68 28t28 68z" + + + +-- LOOKUP + + +lookup : String -> Html msg +lookup fileName = + let + extension = + getExtension fileName + in + Maybe.withDefault file (Dict.get extension extensionIcons) + + +extensionIcons : Dict.Dict String (Html msg) +extensionIcons = + Dict.fromList + [ ("jpg" , image) + , ("jpeg", image) + , ("png" , image) + , ("gif" , image) + ] + + +getExtension : String -> String +getExtension str = + getExtensionHelp (String.split "." str) + + +getExtensionHelp : List String -> String +getExtensionHelp segments = + case segments of + [] -> + "" + + [ext] -> + String.toLower ext + + _ :: rest -> + getExtensionHelp rest diff --git a/browser/src/Index/Navigator.elm b/browser/src/Index/Navigator.elm new file mode 100644 index 00000000..b20b2467 --- /dev/null +++ b/browser/src/Index/Navigator.elm @@ -0,0 +1,78 @@ +module Index.Navigator exposing (view, ()) + + +import Color +import Html exposing (..) +import Html.Attributes exposing (..) + +import TempFontAwesome as FA + + + +-- ADD SLASHES + + +() : String -> String -> String +() directory file = + if String.endsWith "/" directory then + directory ++ file + + else + directory ++ "/" ++ file + + + +-- VIEW + + +view : String -> List String -> Html msg +view root dirs = + div + [ style "font-size" "2em" + , style "padding" "20px 0" + , style "display" "flex" + , style "align-items" "center" + , style "height" "40px" + ] + (makeLinks root dirs "/" []) + + +makeLinks : String -> List String -> String -> List (Html msg) -> List (Html msg) +makeLinks root dirs oldPath revAnchors = + case dirs of + dir :: otherDirs -> + let + newPath = + oldPath dir + + anchor = + a [ href newPath ] [ text dir ] + in + makeLinks root otherDirs newPath (anchor :: revAnchors) + + [] -> + let + home = + a [ href "/" + , title root + , style "display" "inherit" + ] + [ FA.home Color.darkGrey 36 + ] + in + case revAnchors of + [] -> + [home] + + lastAnchor :: otherRevAnchors -> + home :: slash :: List.foldl addSlash [lastAnchor] otherRevAnchors + + +addSlash : Html msg -> List (Html msg) -> List (Html msg) +addSlash front back = + front :: slash :: back + + +slash : Html msg +slash = + span [ style "padding" "0 8px" ] [ text "/" ] diff --git a/browser/src/Index/Skeleton.elm b/browser/src/Index/Skeleton.elm new file mode 100644 index 00000000..143d85c7 --- /dev/null +++ b/browser/src/Index/Skeleton.elm @@ -0,0 +1,75 @@ +module Index.Skeleton exposing + ( view + , box + , readmeBox + ) + +import Color exposing (Color, darkGrey) +import Html exposing (..) +import Html.Attributes exposing (..) +import Markdown + +import TempFontAwesome as FA + + + +-- VIEW + + +view : List (Html msg) -> Html msg +view content = + div [] + [ header [ class "header" ] [] + , div [class "content"] content + ] + + + +-- VIEW BOXES + + +type alias BoxArgs msg = + { title : String + , items : List (List (Html msg)) + , footer : Maybe (String, String) + } + + +box : BoxArgs msg -> Html msg +box { title, items, footer } = + let + realItems = + List.map (div [ class "box-item" ]) items + in + boxHelp title realItems footer + + +readmeBox : String -> Html msg +readmeBox markdown = + let + readme = + Markdown.toHtml [ class "box-item" ] markdown + in + boxHelp "README" [readme] Nothing + + +boxHelp : String -> List (Html msg) -> Maybe (String, String) -> Html msg +boxHelp boxTitle items footer = + div [ class "box" ] <| + div [ class "box-header" ] [ text boxTitle ] + :: items + ++ [ boxFooter footer ] + + +boxFooter : Maybe (String, String) -> Html msg +boxFooter maybeFooter = + case maybeFooter of + Nothing -> + text "" + + Just (path, description) -> + a [ href path + , title description + ] + [ div [ class "box-footer" ] [ FA.plus darkGrey 14 ] + ] diff --git a/browser/src/Main.elm b/browser/src/Main.elm new file mode 100644 index 00000000..cf3dec93 --- /dev/null +++ b/browser/src/Main.elm @@ -0,0 +1,256 @@ +module Index.Dashboard exposing + ( view + ) + + +import Html exposing (..) +import Html.Attributes exposing (class, href, style, title) + +import Elm.Config as Config exposing (Config) +import Elm.License as License +import Elm.Repo as Repo exposing (Repo) +import Elm.Version as Version exposing (Version) +import Index.Icon as Icon +import Index.Navigator as Navigator exposing (()) +import Index.Project as Project exposing (Project, File(..)) +import Index.Skeleton as Skeleton + + + +-- MODEL + + +type alias Model = + { path : String + , status : ProjectStatus + , directory : Status Directory + } + + +type ProjectStatus + = ProjectIsNew + | ProjectIsInvalid + | ProjectIsValid + { root : String + , project : Project.Project + , exactDeps : List (Package.Name, Version.Version) + } + + +type DirectoryStatus + = NotFound + | Waiting + | Found Directory + + + +-- DIRECTORY + + +type alias Directory = + { dirs : List String + , files : List File + , readme : Maybe String + } + + +type alias File = + { name : String + , runnable : Bool + } + + + +-- DECODER + + +decoder : D.Decoder Directory +decoder = + D.map4 Directory + (D.field "path" (D.list D.string)) + (D.field "dirs" (D.list D.string)) + (D.field "files" (D.list fileDecoder)) + (D.field "readme" (D.nullable D.string)) + + +fileDecoder : D.Decoder File +fileDecoder = + D.map2 File + (D.field "name" D.string) + (D.field "runnable" D.bool) + + + +-- NOT FOUND + + +notFound : Html msg +notFound = + div [ class "not-found" ] + [ div [ style "font-size" "12em" ] [ text "404" ] + , div [ style "font-size" "3em" ] [ text "Page not found" ] + ] + + + +-- WAITING + + +waiting : Html msg +waiting = + div [ class "waiting" ] + [ img [ src "/_elm/waiting.gif" ] [] + ] + + + +-- VIEW DIRECTORY + + +viewDirectory : Project -> Directory -> Html msg +viewDirectory project directory = + Skeleton.view + [ Navigator.view pwd + , section [ class "left-column" ] + [ viewFiles directory.dirs directory.files + , viewReadme directory.readme + ] + , section [ class "right-column" ] + [ viewProjectSummary project + , viewDeps project + , viewTestDeps project + ] + , div [ style "clear" "both" ] [] + ] + + + +-- VIEW README + + +viewReadme : Maybe String -> Html msg +viewReadme readme = + case readme of + Nothing -> + text "" + + Just markdown -> + Skeleton.readmeBox markdown + + + +-- VIEW FILES + + +viewFiles : List String -> List File -> Html msg +viewFiles dirs files = + Skeleton.box + { title = "File Navigation" + , items = List.map viewDir dirs ++ List.map viewFile files + , footer = Nothing + } + + +viewDir : String -> List (Html msg) +viewDir dir = + [ a [ href dir ] [ Icon.folder, text dir ] + ] + + +viewFile : File -> List (Html msg) +viewFile {name} = + [ a [ href name ] [ Icon.lookup name, text name ] + ] + + + +-- VIEW PAGE SUMMARY + + +viewProjectSummary : Project.Project -> Html msg +viewProjectSummary project = + case project of + Project.Browser info -> + Skeleton.box + { title = "Source Directories" + , items = List.map (\dir -> [text dir]) info.dirs + , footer = Nothing + } + -- TODO show estimated bundle size here + + Project.Package info -> + Skeleton.box + { title = "Package Info" + , items = + [ [ text ("Name: " ++ info.name) ] + , [ text ("Version: " ++ Version.toString info.version) ] + , [ text ("License: " ++ License.toString info.license) ] + ] + , footer = Nothing + } + + + +-- VIEW DEPENDENCIES + + +viewDeps : ExactDeps -> Project.Project -> Html msg +viewDeps exactDeps project = + let + dependencies = + case project of + Project.Browser info -> + List.map (viewDependency exactDeps) info.deps + + Project.Package info -> + List.map (viewDependency exactDeps) info.deps + in + Skeleton.box + { title = "Dependencies" + , items = dependencies + , footer = Nothing -- TODO Just ("/_elm/dependencies", "Add more dependencies?") + } + + +viewTestDeps : ExactDeps -> Project.Project -> Html msg +viewTestDeps exactDeps project = + let + dependencies = + case project of + Project.Browser info -> + List.map (viewDependency exactDeps) info.testDeps + + Project.Package info -> + List.map (viewDependency exactDeps) info.testDeps + in + Skeleton.box + { title = "Test Dependencies" + , items = dependencies + , footer = Nothing -- TODO Just ("/_elm/test-dependencies", "Add more test dependencies?") + } + + +viewDependency : ExactDeps -> (Package.Name, vsn) -> List (Html msg) +viewDependency exactDeps (pkg, _) = + case Dict.get (Package.toString pkg) exactDeps of + Nothing -> + [ div [ style "float" "left" ] + [ Icon.package + , text (Package.toString pkg) + ] + , div [ style "float" "right" ] [ text "???" ] + ] + + Just version -> + [ div [ style "float" "left" ] + [ Icon.package + , a [ href (toPackageUrl pkg version) ] [ text (Package.toString pkg) ] + ] + , div [ style "float" "right" ] [ text (Version.toString version) ] + ] + + +toPackageUrl : Package.Name -> Version.Version -> String +toPackageUrl name version = + "http://package.elm-lang.org/packages/" + ++ Package.toString name ++ "/" ++ Version.toString version diff --git a/browser/src/NotFound.elm b/browser/src/NotFound.elm new file mode 100644 index 00000000..e69de29b diff --git a/browser/src/Page/Directory.elm b/browser/src/Page/Directory.elm new file mode 100644 index 00000000..5b83f218 --- /dev/null +++ b/browser/src/Page/Directory.elm @@ -0,0 +1,202 @@ +module Page.Directory exposing + ( Info + , File(..) + , decoder + ) + + +import Json.Decode as D + +import Elm.Project as Project + + + + +-- DIRECTORY + + +type alias Directory = + { path : List String + , dirs : List String + , files : List File + , readme : Maybe String + } + + +type alias File = + { name : String + , runnable : Bool + } + + + +-- DECODER + + +decoder : D.Decoder Directory +decoder = + D.map4 Directory + (D.field "path" (D.list D.string)) + (D.field "dirs" (D.list D.string)) + (D.field "files" (D.list fileDecoder)) + (D.field "readme" (D.nullable D.string)) + + +fileDecoder : D.Decoder File +fileDecoder = + D.map2 File + (D.field "name" D.string) + (D.field "runnable" D.bool) + + + +-- VIEW + + +view : Project -> Directory -> Html msg +view project directory = + Skeleton.view + [ Navigator.view pwd + , section [ class "left-column" ] + [ viewFiles directory.dirs directory.files + , viewReadme directory.readme + ] + , section [ class "right-column" ] + [ viewProjectSummary project + , viewDeps project + , viewTestDeps project + ] + , div [ style "clear" "both" ] [] + ] + + + +-- VIEW README + + +viewReadme : Maybe String -> Html msg +viewReadme readme = + case readme of + Nothing -> + text "" + + Just markdown -> + Skeleton.readmeBox markdown + + + +-- VIEW FILES + + +viewFiles : List String -> List File -> Html msg +viewFiles dirs files = + Skeleton.box + { title = "File Navigation" + , items = List.map viewDir dirs ++ List.map viewFile files + , footer = Nothing + } + + +viewDir : String -> List (Html msg) +viewDir dir = + [ a [ href dir ] [ Icon.folder, text dir ] + ] + + +viewFile : File -> List (Html msg) +viewFile {name} = + [ a [ href name ] [ Icon.lookup name, text name ] + ] + + + +-- VIEW PAGE SUMMARY + + +viewProjectSummary : Project.Project -> Html msg +viewProjectSummary project = + case project of + Project.Browser info -> + Skeleton.box + { title = "Source Directories" + , items = List.map (\dir -> [text dir]) info.dirs + , footer = Nothing + } + -- TODO show estimated bundle size here + + Project.Package info -> + Skeleton.box + { title = "Package Info" + , items = + [ [ text ("Name: " ++ info.name) ] + , [ text ("Version: " ++ Version.toString info.version) ] + , [ text ("License: " ++ License.toString info.license) ] + ] + , footer = Nothing + } + + + +-- VIEW DEPENDENCIES + + +viewDeps : ExactDeps -> Project.Project -> Html msg +viewDeps exactDeps project = + let + dependencies = + case project of + Project.Browser info -> + List.map (viewDependency exactDeps) info.deps + + Project.Package info -> + List.map (viewDependency exactDeps) info.deps + in + Skeleton.box + { title = "Dependencies" + , items = dependencies + , footer = Nothing -- TODO Just ("/_elm/dependencies", "Add more dependencies?") + } + + +viewTestDeps : ExactDeps -> Project.Project -> Html msg +viewTestDeps exactDeps project = + let + dependencies = + case project of + Project.Browser info -> + List.map (viewDependency exactDeps) info.testDeps + + Project.Package info -> + List.map (viewDependency exactDeps) info.testDeps + in + Skeleton.box + { title = "Test Dependencies" + , items = dependencies + , footer = Nothing -- TODO Just ("/_elm/test-dependencies", "Add more test dependencies?") + } + + +viewDependency : ExactDeps -> (Package.Name, vsn) -> List (Html msg) +viewDependency exactDeps (pkg, _) = + case Dict.get (Package.toString pkg) exactDeps of + Nothing -> + [ div [ style "float" "left" ] + [ Icon.package + , text (Package.toString pkg) + ] + , div [ style "float" "right" ] [ text "???" ] + ] + + Just version -> + [ div [ style "float" "left" ] + [ Icon.package + , a [ href (toPackageUrl pkg version) ] [ text (Package.toString pkg) ] + ] + , div [ style "float" "right" ] [ text (Version.toString version) ] + ] + + +toPackageUrl : Package.Name -> Version.Version -> String +toPackageUrl name version = + "http://package.elm-lang.org/packages/" + ++ Package.toString name ++ "/" ++ Version.toString version diff --git a/browser/src/Start.elm b/browser/src/Start.elm new file mode 100644 index 00000000..398d2216 --- /dev/null +++ b/browser/src/Start.elm @@ -0,0 +1,203 @@ +module Start exposing (..) + + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Html.Lazy exposing (lazy) +import Http +import Navigation +import String + + +main = + Html.programWithFlags + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + + +-- MODEL + + +type Model + = NoProject String + | PotentialProject String String + | Waiting + + + +-- INIT + + +type alias Flags = + { root : String + , suggestion : Maybe String + } + + +init : Flags -> ( Model, Cmd Msg ) +init flags = + case flags.suggestion of + Nothing -> + ( NoProject flags.root, Cmd.none ) + + Just suggestion -> + ( PotentialProject flags.root suggestion, Cmd.none ) + + + +-- UPDATE + + +type Msg + = RequestNewProject + | NewProjectReady + | IgnoreSuggestion String + | MoveReactor + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + RequestNewProject -> + ( Waiting, createNewProject ) + + NewProjectReady -> + ( Waiting, Navigation.reload ) + + IgnoreSuggestion root -> + ( NoProject root, Cmd.none ) + + MoveReactor -> + ( Waiting, moveReactor ) + + +createNewProject : Cmd Msg +createNewProject = + Http.send (\_ -> NewProjectReady) <| + Http.getString "/_elm/create-new-project" + + +moveReactor : Cmd Msg +moveReactor = + Http.send (\_ -> NewProjectReady) <| + Http.getString "/_elm/move-to-root" + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + + +-- VIEW + + +view : Model -> Html Msg +view model = + case model of + NoProject root -> + viewNoProject root + + PotentialProject root suggestion -> + viewPotentialProject root suggestion + + Waiting -> + viewWaiting + + + +-- VIEW NO PROJECT + + +viewNoProject : String -> Html Msg +viewNoProject root = + div [ class "start" ] + [ div [ class "start-hello" ] + [ h1 [] [ text "Hello!" ] + , para "Looks like you are starting a new Elm project. Exciting!" + , para "I will help you get set up. Just press this button!" + , div [ class "button" ] + [ a [ onClick RequestNewProject ] [ text "Create New Project" ] + ] + ] + , div [ class "start-details" ] + [ h2 [] [ text "What does this button do exactly?" ] + , p [] + [ text "In the " + , code [] [ text root ] + , text " directory, I will create:" + ] + , ul [] + [ file "elm.json" "describes which packages you need." + , file "src/" "a directory for all your Elm code." + , file "src/Main.elm" "an example Elm program." + , file "tests/" "a directory for any tests you write." + ] + , para "I will share more details on all this after you press the button!" + ] + ] + + +para : String -> Html msg +para str = + p [] [ text str ] + + +file : String -> String -> Html msg +file fileName description = + li [] + [ code [] [ text fileName ] + , text " – " + , text description + ] + + + +-- VIEW WAITING + + +viewWaiting : Html msg +viewWaiting = + div [ class "waiting" ] + [ img [ src "/_elm/waiting.gif" ] [] + ] + + + +-- VIEW POTENTIAL PROJECT + + +viewPotentialProject : String -> String -> Html Msg +viewPotentialProject root suggestion = + div [ class "start potential" ] + [ h1 [] [ text "Existing Project?" ] + , p [] + [ text "You ran " + , code [] [ text "elm-reactor" ] + , text " from " + , code [] [ text root ] + , text " which is not the root of an Elm project." + ] + , p [] + [ text "I found an Elm project at " + , code [] [ text suggestion ] + , text " though. Would you like to continue developing that one?" + ] + , div [ class "button" ] + [ a [ onClick MoveReactor ] [ text "Continue Existing Project" ] + ] + , h1 [] [ text "Or New Project?" ] + , para "Or maybe you want some weird nested Elm project, where you have Elm projects within other Elm projects. It is probably better to have them separated, but I can get you set up if that is what you really want!" + , div [ class "button" ] + [ a [ onClick (IgnoreSuggestion root) ] [ text "New Project" ] + ] + ] diff --git a/elm.cabal b/elm.cabal new file mode 100644 index 00000000..6b5070b6 --- /dev/null +++ b/elm.cabal @@ -0,0 +1,189 @@ + +Name: elm +Version: 0.19.0 + +Synopsis: + The `elm` command line interface. + +Description: + This includes commands like `elm make`, `elm repl`, and many others + for helping make Elm developers happy and productive. + +Homepage: http://elm-lang.org + +License: BSD3 +License-file: LICENSE + +Author: Evan Czaplicki +Maintainer: info@elm-lang.org +Copyright: Copyright (c) 2011-present, Evan Czaplicki + +Category: Compiler, Language + +Cabal-version: >=1.9 +Build-type: Simple + +source-repository head + type: git + location: git://github.com/elm-lang/elm-compiler.git + + +Flag dev { + Description: Turn off optimization and make warnings errors + Default: False +} + + +Executable elm + if flag(dev) + ghc-options: -O0 -Wall -Werror + else + ghc-options: -O2 -fsimpl-tick-factor=200 + + Hs-Source-Dirs: + compiler/src + builder/src + cli/src + + Main-Is: + Main.hs + + exposed-modules: + Elm.Compiler, + Elm.Compiler.Module, + Elm.Compiler.Objects, + Elm.Compiler.Type, + Elm.Docs, + Elm.Kernel, + Elm.Header, + Elm.Name, + Elm.Package, + Elm.Utils, + Json.Decode, + Json.Encode + + other-modules: + AST.Canonical, + AST.Optimized, + AST.Source, + AST.Module.Name, + AST.Utils.Binop, + AST.Utils.Shader, + AST.Utils.Type, + AST.Valid, + Canonicalize.Effects, + Canonicalize.Environment, + Canonicalize.Environment.Dups, + Canonicalize.Environment.Foreign, + Canonicalize.Environment.Local, + Canonicalize.Expression, + Canonicalize.Module, + Canonicalize.Pattern, + Canonicalize.Type, + Compile, + Data.Bag, + Data.Index, + Data.OneOrMore, + Elm.Compiler.Imports, + Elm.Compiler.Type.Extract, + Elm.Compiler.Version, + Elm.Interface, + Generate.JavaScript, + Generate.JavaScript.Builder, + Generate.JavaScript.Expression, + Generate.JavaScript.Name, + Json.Decode.Internals, + Nitpick.PatternMatches, + Optimize.Case, + Optimize.DecisionTree, + Optimize.Expression, + Optimize.Module, + Optimize.Names, + Optimize.Port, + Parse.Declaration, + Parse.Expression, + Parse.Module, + Parse.Parse, + Parse.Pattern, + Parse.Primitives, + Parse.Primitives.Internals, + Parse.Primitives.Kernel, + Parse.Primitives.Keyword, + Parse.Primitives.Number, + Parse.Primitives.Shader, + Parse.Primitives.Symbol, + Parse.Primitives.Utf8, + Parse.Primitives.Variable, + Parse.Primitives.Whitespace, + Parse.Repl, + Parse.Shader, + Parse.Type, + Reporting.Annotation, + Reporting.Error, + Reporting.Error.Canonicalize, + Reporting.Error.Docs, + Reporting.Error.Json, + Reporting.Error.Main, + Reporting.Error.Pattern, + Reporting.Error.Syntax, + Reporting.Error.Type, + Reporting.Helpers, + Reporting.Region, + Reporting.Render.Code, + Reporting.Render.Type, + Reporting.Report, + Reporting.Result, + Reporting.Warning, + Type.Constrain.Expression, + Type.Constrain.Module, + Type.Constrain.Pattern, + Type.Error, + Type.Instantiate, + Type.Occurs, + Type.Solve, + Type.Type, + Type.Unify, + Type.UnionFind, + Validate, + Paths_elm_compiler + + Build-depends: + ansi-terminal >= 0.7 && < 0.8, + ansi-wl-pprint >= 0.6.7 && < 0.7, + base >=4.8 && <5, + binary >= 0.8 && < 0.9, + blaze-html, + blaze-markup, + bytestring >= 0.9 && < 0.11, + containers >= 0.5.8.2 && < 0.6, + directory >= 1.2.3.0 && < 2.0, + edit-distance >= 0.2 && < 0.3, + filepath >= 1 && < 2.0, + ghc-prim, + haskeline, + HTTP >= 4000.2.5 && < 4000.4, + http-client >= 0.5 && < 0.6, + http-client-tls >= 0.3 && < 0.4, + http-types >= 0.9 && < 1.0, + language-glsl >= 0.0.2 && < 0.3, + logict, + mtl >= 2.2.1 && < 3, + network >= 2.4 && < 2.7, + parsec, + pretty >= 1.0 && < 2.0, + process, + raw-strings-qq, + scientific, + semigroups, + SHA, + snap-core, + snap-server, + template-haskell, + text >= 1 && < 2, + time, + unordered-containers, + utf8-string, + vector, + websockets, + websockets-snap, + zip-archive diff --git a/cli/elm.cabal b/terminal/elm.cabal similarity index 100% rename from cli/elm.cabal rename to terminal/elm.cabal diff --git a/cli/src/Bump.hs b/terminal/src/Bump.hs similarity index 100% rename from cli/src/Bump.hs rename to terminal/src/Bump.hs diff --git a/cli/src/CommandLine/Args.hs b/terminal/src/CommandLine/Args.hs similarity index 100% rename from cli/src/CommandLine/Args.hs rename to terminal/src/CommandLine/Args.hs diff --git a/cli/src/CommandLine/Args/Internal.hs b/terminal/src/CommandLine/Args/Internal.hs similarity index 100% rename from cli/src/CommandLine/Args/Internal.hs rename to terminal/src/CommandLine/Args/Internal.hs diff --git a/cli/src/Develop.hs b/terminal/src/Develop.hs similarity index 100% rename from cli/src/Develop.hs rename to terminal/src/Develop.hs diff --git a/cli/src/Develop/Compile.hs b/terminal/src/Develop/Compile.hs similarity index 100% rename from cli/src/Develop/Compile.hs rename to terminal/src/Develop/Compile.hs diff --git a/cli/src/Develop/Generate/Help.hs b/terminal/src/Develop/Generate/Help.hs similarity index 100% rename from cli/src/Develop/Generate/Help.hs rename to terminal/src/Develop/Generate/Help.hs diff --git a/cli/src/Develop/Generate/Index.hs b/terminal/src/Develop/Generate/Index.hs similarity index 100% rename from cli/src/Develop/Generate/Index.hs rename to terminal/src/Develop/Generate/Index.hs diff --git a/cli/src/Develop/Generate/NotFound.hs b/terminal/src/Develop/Generate/NotFound.hs similarity index 100% rename from cli/src/Develop/Generate/NotFound.hs rename to terminal/src/Develop/Generate/NotFound.hs diff --git a/cli/src/Develop/Socket.hs b/terminal/src/Develop/Socket.hs similarity index 100% rename from cli/src/Develop/Socket.hs rename to terminal/src/Develop/Socket.hs diff --git a/cli/src/Develop/StaticFiles.hs b/terminal/src/Develop/StaticFiles.hs similarity index 100% rename from cli/src/Develop/StaticFiles.hs rename to terminal/src/Develop/StaticFiles.hs diff --git a/cli/src/Develop/StaticFiles/Build.hs b/terminal/src/Develop/StaticFiles/Build.hs similarity index 100% rename from cli/src/Develop/StaticFiles/Build.hs rename to terminal/src/Develop/StaticFiles/Build.hs diff --git a/cli/src/Diff.hs b/terminal/src/Diff.hs similarity index 100% rename from cli/src/Diff.hs rename to terminal/src/Diff.hs diff --git a/cli/src/Install.hs b/terminal/src/Install.hs similarity index 100% rename from cli/src/Install.hs rename to terminal/src/Install.hs diff --git a/cli/src/Main.hs b/terminal/src/Main.hs similarity index 100% rename from cli/src/Main.hs rename to terminal/src/Main.hs diff --git a/cli/src/Make.hs b/terminal/src/Make.hs similarity index 100% rename from cli/src/Make.hs rename to terminal/src/Make.hs diff --git a/cli/src/Publish.hs b/terminal/src/Publish.hs similarity index 100% rename from cli/src/Publish.hs rename to terminal/src/Publish.hs diff --git a/cli/src/Repl.hs b/terminal/src/Repl.hs similarity index 100% rename from cli/src/Repl.hs rename to terminal/src/Repl.hs