Add more examples #22

compiler/src/Data/Graph.elm

@@ -4,12 +4,10 @@ module Data.Graph exposing
     , Graph
     , SCC(..)
     , Table
-    ,  Vertex
-       -- , bcc
-
-    ,  buildG
-       -- , components
-
+    , Vertex
+      -- , bcc
+    , buildG
+      -- , components
     , dff
     , dfs
     , edges
@@ -18,16 +16,14 @@ module Data.Graph exposing
     , graphFromEdges
     , graphFromEdges_
     , indegree
-    ,  outdegree
-       -- , path
-       -- , reachable
-       -- , reverseTopSort
-
+    , outdegree
+      -- , path
+      -- , reachable
+      -- , reverseTopSort
     , scc
     , stronglyConnComp
-    ,  stronglyConnCompR
-       -- , topSort
-
+    , stronglyConnCompR
+      -- , topSort
     , transposeG
     , vertices
     )

compiler/src/Parse/Shader.elm

@@ -1,12 +1,16 @@
 module Parse.Shader exposing (shader)
 
+-- import Language.GLSL.Parser as GLP
+
 import AST.Source as Src
 import AST.Utils.Shader as Shader
 import Data.Map as Dict
 import Data.Name as Name
+import Language.GLSL.Syntax as GLS
 import Parse.Primitives as P exposing (Col, Parser, Row)
 import Reporting.Annotation as A
 import Reporting.Error.Syntax as E
+import Utils.Crash as Crash
 
 
 
@@ -157,41 +161,54 @@ emptyTypes =
     Shader.Types Dict.empty Dict.empty Dict.empty
 
 
+addInput : ( GLS.StorageQualifier, Shader.Type, String ) -> Shader.Types -> Shader.Types
+addInput ( qual, tipe, name ) (Shader.Types attribute uniform varying) =
+    case qual of
+        GLS.Attribute ->
+            Shader.Types (Dict.insert compare name tipe attribute) uniform varying
+
+        GLS.Uniform ->
+            Shader.Types attribute (Dict.insert compare name tipe uniform) varying
+
+        GLS.Varying ->
+            Shader.Types attribute uniform (Dict.insert compare name tipe varying)
+
+        _ ->
+            Crash.crash "Should never happen due to `extractInputs` function"
+
+
+extractInputs : GLS.ExternalDeclaration -> List ( GLS.StorageQualifier, Shader.Type, String )
+extractInputs decl =
+    case decl of
+        GLS.Declaration (GLS.InitDeclaration (GLS.TypeDeclarator (GLS.FullType (Just (GLS.TypeQualSto qual)) (GLS.TypeSpec _ (GLS.TypeSpecNoPrecision tipe _)))) [ GLS.InitDecl name _ _ ]) ->
+            if List.member qual [ GLS.Attribute, GLS.Varying, GLS.Uniform ] then
+                case tipe of
+                    GLS.Vec2 ->
+                        [ ( qual, Shader.V2, name ) ]
+
+                    GLS.Vec3 ->
+                        [ ( qual, Shader.V3, name ) ]
+
+                    GLS.Vec4 ->
+                        [ ( qual, Shader.V4, name ) ]
+
+                    GLS.Mat4 ->
+                        [ ( qual, Shader.M4, name ) ]
+
+                    GLS.Int ->
+                        [ ( qual, Shader.Int, name ) ]
+
+                    GLS.Float ->
+                        [ ( qual, Shader.Float, name ) ]
+
+                    GLS.Sampler2D ->
+                        [ ( qual, Shader.Texture, name ) ]
+
+                    _ ->
+                        []
+
+            else
+                []
 
--- addInput : ( GLS.StorageQualifier, Shader.Type, String ) -> Shader.Types -> Shader.Types
--- addInput ( qual, tipe, name ) glDecls =
---     case qual of
---         GLS.Attribute ->
---             { glDecls | attribute = Dict.insert (Name.fromChars name) tipe glDecls.attribute }
---         GLS.Uniform ->
---             { glDecls | uniform = Dict.insert (Name.fromChars name) tipe glDecls.uniform }
---         GLS.Varying ->
---             { glDecls | varying = Dict.insert (Name.fromChars name) tipe glDecls.varying }
---         _ ->
---             Debug.crash "Should never happen due to `extractInputs` function"
--- extractInputs : GLS.ExternalDeclaration -> List ( GLS.StorageQualifier, Shader.Type, String )
--- extractInputs decl =
---     case decl of
---         GLS.Declaration (GLS.InitDeclaration (GLS.TypeDeclarator (GLS.FullType (Just (GLS.TypeQualSto qual)) (GLS.TypeSpec _ prec (GLS.TypeSpecNoPrecision tipe _ mexpr1)))) [ GLS.InitDecl name _ mexpr2 _ mexpr3 ]) ->
---             if List.member qual [ GLS.Attribute, GLS.Varying, GLS.Uniform ] then
---                 case tipe of
---                     GLS.Vec2 ->
---                         [ ( qual, Shader.V2, name ) ]
---                     GLS.Vec3 ->
---                         [ ( qual, Shader.V3, name ) ]
---                     GLS.Vec4 ->
---                         [ ( qual, Shader.V4, name ) ]
---                     GLS.Mat4 ->
---                         [ ( qual, Shader.M4, name ) ]
---                     GLS.Int ->
---                         [ ( qual, Shader.Int, name ) ]
---                     GLS.Float ->
---                         [ ( qual, Shader.Float, name ) ]
---                     GLS.Sampler2D ->
---                         [ ( qual, Shader.Texture, name ) ]
---                     _ ->
---                         []
---             else
---                 []
---         _ ->
---             []
+        _ ->
+            []

compiler/src/Reporting/Doc.elm

@@ -26,16 +26,14 @@ module Reporting.Doc exposing
     , fromPackage
     , fromVersion
     , green
-    ,  hang
-       -- , hcat
-
+    , hang
+      -- , hcat
     , hsep
     , indent
     , intToOrdinal
     , join
-    ,  link
-       -- , magenta
-
+    , link
+      -- , magenta
     , makeLink
     , makeNakedLink
     , moreArgs

compiler/src/Reporting/Render/Type.elm

@@ -73,8 +73,7 @@ tuple : D.Doc -> D.Doc -> List D.Doc -> D.Doc
 tuple a b cs =
     let
         entries =
-            List.interweave (D.fromChars "(" :: List.repeat (List.length (b :: cs)) (D.fromChars ",")) (a :: b :: cs)
-                |> List.intersperse (D.fromChars " ")
+            List.interweave (D.fromChars "( " :: List.repeat (List.length (b :: cs)) (D.fromChars ", ")) (a :: b :: cs)
     in
     D.align <| D.sep [ D.cat entries, D.fromChars ")" ]
 

examples/elm.json

@@ -8,16 +8,19 @@
         "direct": {
             "elm/browser": "1.0.2",
             "elm/core": "1.0.5",
+            "elm/file": "1.0.5",
             "elm/html": "1.0.0",
             "elm/http": "2.0.0",
             "elm/json": "1.1.3",
             "elm/random": "1.0.0",
             "elm/svg": "1.0.1",
-            "elm/time": "1.0.0"
+            "elm/time": "1.0.0",
+            "elm-explorations/linear-algebra": "1.0.3",
+            "elm-explorations/webgl": "1.1.3",
+            "evancz/elm-playground": "1.0.3"
         },
         "indirect": {
             "elm/bytes": "1.0.8",
-            "elm/file": "1.0.5",
             "elm/url": "1.0.0",
             "elm/virtual-dom": "1.0.3"
         }

examples/src/Animation.elm

@@ -0,0 +1,27 @@
+module Animation exposing (main)
+
+-- Create animations that spin, wave, and zig-zag.
+-- This one is a little red wagon bumping along a dirt road.
+--
+-- Learn more about the playground here:
+--   https://package.elm-lang.org/packages/evancz/elm-playground/latest/
+--
+
+import Playground exposing (..)
+
+
+main =
+    animation view
+
+
+view time =
+    [ octagon darkGray 36
+        |> moveLeft 100
+        |> rotate (spin 3 time)
+    , octagon darkGray 36
+        |> moveRight 100
+        |> rotate (spin 3 time)
+    , rectangle red 300 80
+        |> moveUp (wave 50 54 2 time)
+        |> rotate (zigzag -2 2 8 time)
+    ]

examples/src/Book.elm

@@ -0,0 +1,90 @@
+module Book exposing (main)
+
+-- Make a GET request to load a book called "Public Opinion"
+--
+-- Read how it works:
+--   https://guide.elm-lang.org/effects/http.html
+--
+
+import Browser
+import Html exposing (Html, pre, text)
+import Http
+
+
+
+-- MAIN
+
+
+main =
+    Browser.element
+        { init = init
+        , update = update
+        , subscriptions = subscriptions
+        , view = view
+        }
+
+
+
+-- MODEL
+
+
+type Model
+    = Failure
+    | Loading
+    | Success String
+
+
+init : () -> ( Model, Cmd Msg )
+init _ =
+    ( Loading
+    , Http.get
+        { url = "https://elm-lang.org/assets/public-opinion.txt"
+        , expect = Http.expectString GotText
+        }
+    )
+
+
+
+-- UPDATE
+
+
+type Msg
+    = GotText (Result Http.Error String)
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        GotText result ->
+            case result of
+                Ok fullText ->
+                    ( Success fullText, Cmd.none )
+
+                Err _ ->
+                    ( Failure, Cmd.none )
+
+
+
+-- SUBSCRIPTIONS
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Sub.none
+
+
+
+-- VIEW
+
+
+view : Model -> Html Msg
+view model =
+    case model of
+        Failure ->
+            text "I was unable to load your book."
+
+        Loading ->
+            text "Loading..."
+
+        Success fullText ->
+            pre [] [ text fullText ]