Initial commit for backend

frontend/src/Data.elm

@@ -0,0 +1,45 @@
+module Data exposing (Provider(..), Url, pathSeparator, toHost, toUrl)
+
+
+hostname : String
+hostname =
+    "https://cdn.hitsofcode.com/"
+
+
+type Provider
+    = GitHub
+    | Bitbucket
+
+
+type alias Url =
+    { prov : Provider
+    , user : String
+    , repo : String
+    , gitref : String
+    , file : String
+    }
+
+
+toHost : Provider -> String
+toHost prov =
+    case prov of
+        GitHub ->
+            "github/"
+
+        Bitbucket ->
+            "bitbucket/"
+
+
+pathSeparator : Provider -> String
+pathSeparator prov =
+    case prov of
+        GitHub ->
+            "blob"
+
+        Bitbucket ->
+            "src"
+
+
+toUrl : Url -> String
+toUrl { prov, user, repo, gitref, file } =
+    hostname ++ toHost prov ++ String.join "/" [ user, repo, pathSeparator prov, gitref, file ]

frontend/src/Main.elm

@@ -0,0 +1,98 @@
+module Main exposing (Model, Msg(..), init, main, update, view)
+
+import Browser
+import Data exposing (Url, toHost, toUrl)
+import Html exposing (Html, br, div, input, table, td, text, tr)
+import Html.Attributes exposing (disabled, placeholder, style, value)
+import Html.Events exposing (onInput)
+import Parse exposing (parseUrl)
+
+
+type Msg
+    = UrlChange String
+
+
+type alias Model =
+    { url : String
+    , parsed : Maybe Url
+    }
+
+
+init : Model
+init =
+    { url = ""
+    , parsed = Nothing
+    }
+
+
+update : Msg -> Model -> Model
+update msg state =
+    case msg of
+        UrlChange newUrl ->
+            { state | url = newUrl, parsed = parseUrl newUrl }
+
+
+renderUrl : Url -> Html msg
+renderUrl { prov, user, repo, file } =
+    div myStyle
+        [ table myStyle
+            [ tr myStyle
+                [ td myStyle [ text "host" ]
+                , td myStyle [ text (toHost prov) ]
+                ]
+            , tr []
+                [ td myStyle [ text "user" ]
+                , td myStyle [ text user ]
+                ]
+            , tr myStyle
+                [ td myStyle [ text "repo" ]
+                , td myStyle [ text repo ]
+                ]
+            , tr myStyle
+                [ td myStyle [ text "file" ]
+                , td myStyle [ text file ]
+                ]
+            ]
+        ]
+
+
+renderMUrl : Maybe Url -> Html msg
+renderMUrl mUrl =
+    mUrl
+        |> Maybe.map renderUrl
+        |> Maybe.withDefault (div myStyle [ text "Parse Error" ])
+
+
+displayMUrl : Maybe Url -> String
+displayMUrl mUrl =
+    mUrl
+        |> Maybe.map toUrl
+        |> Maybe.withDefault ""
+
+
+myStyle : List (Html.Attribute msg)
+myStyle =
+    [ style "width" "100%" ]
+
+
+myStyle2 : List (Html.Attribute msg) -> List (Html.Attribute msg)
+myStyle2 =
+    List.append myStyle
+
+
+view : Model -> Html Msg
+view state =
+    div myStyle
+        [ input (myStyle2 [ placeholder "URL to parse", value state.url, onInput UrlChange ]) []
+        , div myStyle
+            [ text "Parsed URL: "
+            , br [] []
+            , renderMUrl state.parsed
+            ]
+        , input (myStyle2 [ placeholder "https://host/<service>/<user>/<repo>/<gitref>/<file>", disabled True, value (displayMUrl state.parsed) ]) []
+        ]
+
+
+main : Program () Model Msg
+main =
+    Browser.sandbox { init = init, update = update, view = view }

frontend/src/Parse.elm

@@ -0,0 +1,87 @@
+module Parse exposing (parseUrl)
+
+import Data exposing (Provider(..), Url, pathSeparator)
+
+
+parseUrl : String -> Maybe Url
+parseUrl url =
+    stripProtocol url
+        |> splitProvider
+        |> Maybe.andThen splitOfHead
+        |> Maybe.andThen splitOfHead
+        |> Maybe.andThen splitOfHead
+        |> Maybe.andThen splitOfHead
+        |> Maybe.andThen
+            (\( ( ( ( ( prov, user ), repo ), separator ), gitref ), file ) ->
+                if List.isEmpty file || (separator /= pathSeparator prov) then
+                    Nothing
+
+                else
+                    Just
+                        { prov = prov
+                        , user = user
+                        , repo = repo
+                        , gitref = gitref
+                        , file = String.join "/" file
+                        }
+            )
+
+
+splitOfHead : ( a, List b ) -> Maybe ( ( a, b ), List b )
+splitOfHead ( head, tail ) =
+    splitPart tail
+        |> Maybe.map (\( h, t ) -> ( ( head, h ), t ))
+
+
+stripProtocol : String -> String
+stripProtocol url =
+    let
+        index =
+            String.indexes "://" url
+                |> List.head
+                |> Maybe.withDefault -3
+    in
+    String.dropLeft (index + 3) url
+
+
+parseProvider : String -> Maybe Provider
+parseProvider prov =
+    case String.toLower prov of
+        "github.com" ->
+            Just GitHub
+
+        "bitbucket.org" ->
+            Just Bitbucket
+
+        _ ->
+            Nothing
+
+
+splitProvider : String -> Maybe ( Provider, List String )
+splitProvider url =
+    let
+        split =
+            String.split "/" url
+
+        parts =
+            splitPart split
+    in
+    parts
+        |> Maybe.andThen
+            (\( head, tail ) ->
+                parseProvider head
+                    |> Maybe.map (\prov -> ( prov, tail ))
+            )
+
+
+splitPart : List a -> Maybe ( a, List a )
+splitPart parts =
+    let
+        head =
+            List.head parts
+
+        tail =
+            List.tail parts
+    in
+    head
+        |> Maybe.andThen (\h -> Maybe.map (\t -> ( h, t )) tail)