Add a common convenience implementation of the TCP abstraction on a mirage back-end

module Flow = Conduit_mirage.Flow
module Channel = Mirage_channel_lwt.Make(Flow)

type socket =
  { ic : Channel.t
  ; oc : Channel.t }

module Log =
struct
  let src = Logs.Src.create "git.mirage.net" ~doc:"logs git's mirage net event"
  include (val Logs.src_log src : Logs.LOG)
end

let close socket =
  let open Lwt.Infix in

  let safe_close c =
    Channel.close c >>= function
    | Ok ()
    | Error `Closed -> Lwt.return ()
    | Error e ->
      Log.debug (fun l -> l "Ignoring error: %a" Channel.pp_write_error e);
      Lwt.return ()
  in
  safe_close socket.ic >>= fun () ->
  safe_close socket.oc

let write { oc; _ } raw off len =
  Channel.write_string oc (Bytes.unsafe_to_string raw) off len;
  Lwt.return len

let read { ic; _ } raw off len =
  let open Lwt.Infix in

  Channel.read_some ~len ic >>= function
  | Ok `Eof -> Lwt.return 0
  | Ok (`Data cs) ->
    let len' = Cstruct.len cs in
    Cstruct.blit_to_bytes cs 0 raw off len';
    Lwt.return len'
  | Error err ->
    Log.err (fun l -> l ~header:"read" "Catch error when we read: %a."
                Channel.pp_error err);
    Lwt.return 0

let resolver = Resolver_mirage.localhost
let conduit = Conduit_mirage.empty

let socket host port =
  let uri =
    Uri.empty
    |> fun uri -> Uri.with_host uri (Some host)
    |> fun uri -> Uri.with_port uri (Some port)
  in
  let open Lwt.Infix in

  Resolver_lwt.resolve_uri ~uri resolver >>= fun endp ->
  Conduit_mirage.client endp >>= fun client ->
  Conduit_mirage.connect conduit client >>= fun flow ->
  let ic = Channel.create flow in
  let oc = Channel.create flow in

  Lwt.return { ic; oc; }


(**
 * Copyright (c) 2015, Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD-style license found in the
 * LICENSE file in the "hack" directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *
 *)

type kind =
  | Class
  | Function
  | Method of string * string
  | LocalVar
  | Property of string * string
  | ClassConst of string * string
  | Typeconst of string * string
  | GConst

type 'a t = {
  name:  string;
  type_: kind;
  (* Span of the symbol itself *)
  pos: 'a Pos.pos;
}

let to_absolute x = { x with
  pos = Pos.to_absolute x.pos;
}

Merge code for readable printing of symbols in tests and in client

(**
 * Copyright (c) 2015, Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD-style license found in the
 * LICENSE file in the "hack" directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *
 *)

type kind =
  | Class
  | Function
  | Method of string * string
  | LocalVar
  | Property of string * string
  | ClassConst of string * string
  | Typeconst of string * string
  | GConst

type 'a t = {
  name:  string;
  type_: kind;
  (* Span of the symbol itself *)
  pos: 'a Pos.pos;
}

let to_absolute x = { x with
  pos = Pos.to_absolute x.pos;
}

let kind_to_string = function
  | Class -> "class"
  | Method _ -> "method"
  | Function -> "function"
  | LocalVar -> "local"
  | Property _ -> "property"
  | ClassConst _ -> "class_const"
  | Typeconst _ -> "typeconst"
  | GConst -> "global_const"


Add a Log reporter for asl using our existing convention

(*
 * Copyright (C) 2016 David Scott <dave.scott@docker.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 *)
let install () =
  let home = try Unix.getenv "HOME" with Not_found -> failwith "No $HOME environment variable defined" in
  let (/) = Filename.concat in
  let localtime = Unix.localtime @@ Unix.gettimeofday () in
  let dir = Printf.sprintf "%04d-%02d-%02d"
    (localtime.Unix.tm_year + 1900)
    (localtime.Unix.tm_mon + 1)
    localtime.Unix.tm_mday in
  let log_root = [ "Library"; "Containers"; "com.docker.docker"; "Data"; "logs"; dir ] in
  (* mkdir -p *)
  ignore @@ List.fold_left (fun cwd dir ->
    let path = cwd / dir in
    ( try Unix.mkdir (home / path) 0o0755 with | Unix.Unix_error(Unix.EEXIST, _, _) -> () );
    path
  ) "" log_root;
  let ident = Filename.basename Sys.executable_name in
  let file = List.fold_left (/) home (log_root @ [ ident ^ ".log" ]) in
  let fd = Unix.openfile file [ Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT ] 0o0644 in
  let client = Asl.Client.create ~ident ~facility:"Daemon" () in
  let msg_fmt = "$((Time)(ISO8601.6)) $((Level)(str)) - $Message" in
  let time_fmt = "$((Time)(utc))" in
  if not (Asl.Client.add_output_file client fd msg_fmt time_fmt `Debug) then begin
    failwith (Printf.sprintf "Failed to start logging to %s" file)
  end;
  Logs.set_reporter (Log_asl.reporter ~client ())


Add test for local opens of functor applications with existentials

(* TEST
   * expect
*)
module Ext (X : sig type 'a t end) = struct
  type t = T : 'a X.t -> t
end;;

let foo (x : Ext(List).t) =
  match x with
  | T l ->
    let open Ext(Array) in
    T (Array.of_list l);;
[%%expect {|
module Ext :
  functor (X : sig type 'a t end) -> sig type t = T : 'a X.t -> t end
Lines 8-9, characters 4-23:
8 | ....let open Ext(Array) in
9 |     T (Array.of_list l)..
Error: This expression has type t but an expression was expected of type
         Ext(Array).t
       The type constructor t would escape its scope
       t is abstract because no corresponding cmi file was found in path.
|}]


Add a script to fill en.po with source strings

(* For each source string that has no translation, copy msgid as translation *)
(* Usage: ocaml fill_en_po.ml < en.po | sponge en.po *)

#use "topfind";;
#require "pcre";;

let rex = Pcre.regexp "^msgid (.*)$"

let rec process_msgid ic oc =
  match input_line ic with
  | exception End_of_file -> ()
  | line ->
     match Pcre.exec ~rex line with
     | s -> process_msgstr (Pcre.get_substring s 1) ic oc
     | exception Not_found ->
        Printf.fprintf oc "%s\n%!" line;
        process_msgid ic oc

and process_msgstr msgid ic oc =
  match input_line ic with
  | exception End_of_file -> failwith "unexpected eof"
  | line ->
     if line = "msgstr \"\"" then
       process_empty msgid ic oc
     else (
       Printf.fprintf oc "msgid %s\n%s\n%!" msgid line;
       process_msgid ic oc
     )

and process_empty msgid ic oc =
  match input_line ic with
  | exception End_of_file ->
     Printf.fprintf oc "msgid %s\nmsgstr %s\n%!" msgid msgid;
  | line ->
     if line = "" then (
       Printf.fprintf oc "msgid %s\nmsgstr %s\n\n%!" msgid msgid;
       process_msgid ic oc
     ) else (
       Printf.fprintf oc "msgid %s\nmsgstr \"\"\n%s\n" msgid line;
       process_msgid ic oc
     )

let () = process_msgid stdin stdout


let parse s  =
  Parser.extension_range_list_ Lexer.lexer (Lexing.from_string s)

let parse_extension s  =
  Parser.extension_ Lexer.lexer (Lexing.from_string s)

let () =
  let s ="1" in
  let ev = parse s in
  assert(Pbpt.Extension_single_number 1 = List.hd ev);
  ()

let () =
  let s ="1 to 2" in
  let ev = parse s in
  assert(Pbpt.Extension_range (1, Pbpt.To_number 2) = List.hd ev);
  ()

let () =
  let s ="1 to -1" in
  let ev = parse s in
  assert(Pbpt.Extension_range (1, Pbpt.To_number (-1)) = List.hd ev);
  ()

let () =
  let s ="1 to max" in
  let ev = parse s in
  assert(Pbpt.Extension_range (1, Pbpt.To_max) = List.hd ev);
  ()

let () =
  let s  = "1,2,3 to 10, 11 to max" in
  let ev = parse s in
  begin
    match ev with
    | ev1::ev2::ev3::ev4::[] -> (
      assert(Pbpt.Extension_single_number 1 = ev1);
      assert(Pbpt.Extension_single_number 2 = ev2);
      assert(Pbpt.Extension_range (3, Pbpt.To_number 10) = ev3);
      assert(Pbpt.Extension_range (11, Pbpt.To_max) = ev4)
    )
    | _ -> (assert false: unit)
  end;
  ()

let () =
  let s  = "extensions 1,2,3 to 10, 11 to max;" in
  let ev = parse_extension s in
  begin
    match ev with
    | ev1::ev2::ev3::ev4::[] -> (
      assert(Pbpt.Extension_single_number 1 = ev1);
      assert(Pbpt.Extension_single_number 2 = ev2);
      assert(Pbpt.Extension_range (3, Pbpt.To_number 10) = ev3);
      assert(Pbpt.Extension_range (11, Pbpt.To_max) = ev4)
    )
    | _ -> (assert false: unit)
  end;
  ()

let test_failure f =
  match f() with
  | x -> (assert false:unit)
  | exception (Failure _) -> ()

let () =
  let s  = "1 until 2" in
  test_failure (fun () -> parse s);
  ()

let () =
  let s  = "1 to min" in
  test_failure (fun () -> parse s);
  ()

let () =
  print_endline "Parse Extension Range... Ok"


type t = Binstr of string;;

let empty = Binstr "";;

let unsafe_s binstr =
    match binstr with
    | (Binstr str) -> str
;;

let unsafe_b str = (Binstr str);;

let size binstr = String.length (unsafe_s binstr);;

let concat b1 b2 = (unsafe_b ((unsafe_s b1) ^ (unsafe_s b2)));;

let of_int n =
    let reduce_int i = if i = 0 then 0 else 1 in
    let rec convert pos binstr remainder =
        if remainder = 0 then binstr
        else begin
            let md = remainder mod (ipow 2 (pos+1)) in
            let current = (unsafe_b (string_of_int (reduce_int md))) in
            let updated = (concat current binstr) in
            convert (pos+1) updated (remainder-md)
        end
    in
    if n = 0 then (unsafe_b "0")
    else (convert 0 empty n)
;;

let of_char c =
    let code = Char.code c in
    of_int code
;;

let of_string s =
    let rec convert pos binstr remainder =
        if remainder = "" then binstr
        else begin
            let c = remainder.[0] in
            let c_binstr = byte_pad_left (of_char c) in
            let updated = (concat c_binstr binstr) in
            let r = remove_str 1 remainder in
            convert (pos+1) updated r
        end
    in (convert 0 empty s)
;;

let to_int b =
    let str = (unsafe_s b) in
    let rec convert total remainder =
        let len = (String.length remainder) in
        if len = 0 then total
        else begin
            let coeff = (char_to_int remainder.[0]) in
            let n = (ipow 2 (len-1)) * coeff in
            let r = remove_str 1 remainder in
            convert (n+total) r
        end
    in convert 0 str
;;


(** The AST of a [.ml] or [.mli]. *)
open SmartPrint
open Monad.Notations

type t =
  | SignatureAxioms of SignatureAxioms.t
  | Structure of Structure.t list

let get_initial_loc (typedtree : Mtyper.typedtree) : Loc.t =
  match typedtree with
  | `Implementation structure ->
    begin match structure.str_items with
    | structure_item :: _ -> Loc.of_location structure_item.str_loc
    | [] -> failwith "Unexpected empty file"
    end
  | `Interface signature ->
    begin match signature.sig_items with
    | signature_item :: _ -> Loc.of_location signature_item.sig_loc
    | [] -> failwith "Unexpected empty file"
    end

let of_typedtree (typedtree : Mtyper.typedtree) : t Monad.t =
  match typedtree with
  | `Implementation structure ->
    Structure.of_structure structure >>= fun structure ->
    return (Structure structure)
  | `Interface signature ->
    SignatureAxioms.of_signature signature >>= fun signature ->
    return (SignatureAxioms signature)

let to_coq (ast : t) : SmartPrint.t =
  concat (List.map (fun d -> d ^^ newline) [
    !^ "Require Import OCaml.OCaml." ^^ newline;
    !^ "Local Open Scope Z_scope.";
    !^ "Local Open Scope type_scope.";
    !^ "Import ListNotations."
  ]) ^^ newline ^^
  match ast with
  | SignatureAxioms signature -> SignatureAxioms.to_coq signature
  | Structure structure -> Structure.to_coq structure

Add a new line at the end of the files

(** The AST of a [.ml] or [.mli]. *)
open SmartPrint
open Monad.Notations

type t =
  | SignatureAxioms of SignatureAxioms.t
  | Structure of Structure.t list

let get_initial_loc (typedtree : Mtyper.typedtree) : Loc.t =
  match typedtree with
  | `Implementation structure ->
    begin match structure.str_items with
    | structure_item :: _ -> Loc.of_location structure_item.str_loc
    | [] -> failwith "Unexpected empty file"
    end
  | `Interface signature ->
    begin match signature.sig_items with
    | signature_item :: _ -> Loc.of_location signature_item.sig_loc
    | [] -> failwith "Unexpected empty file"
    end

let of_typedtree (typedtree : Mtyper.typedtree) : t Monad.t =
  match typedtree with
  | `Implementation structure ->
    Structure.of_structure structure >>= fun structure ->
    return (Structure structure)
  | `Interface signature ->
    SignatureAxioms.of_signature signature >>= fun signature ->
    return (SignatureAxioms signature)

let to_coq (ast : t) : SmartPrint.t =
  concat (List.map (fun d -> d ^^ newline) [
    !^ "Require Import OCaml.OCaml." ^^ newline;
    !^ "Local Open Scope Z_scope.";
    !^ "Local Open Scope type_scope.";
    !^ "Import ListNotations."
  ]) ^^ newline ^^
  (match ast with
  | SignatureAxioms signature -> SignatureAxioms.to_coq signature
  | Structure structure -> Structure.to_coq structure) ^^
  newline


open Core.Std
open Core_bench.Std

let map_iter ~num_keys ~iterations =
    let rec loop i map =
    if i <= 0 then ()
    else loop (i - 1)
        (
            Map.change map (i mod num_keys) (
            fun current -> Some (1 + Option.value ~default:0 current)
            )
        )
    in
    loop iterations Int.Map.empty

let table_iter ~num_keys ~iterations =
    let table = Int.Table.create ~size:num_keys () in
    let rec loop i =
    if i <= 0 then ()
    else (
        Hashtbl.change table (i mod num_keys) (
            fun current -> Some (1 + Option.value ~default:0 current)
        );
        loop (i - 1)
    )
  in
  loop iterations

let tests ~num_keys ~iterations =
    let test name f = Bench.Test.create f ~name in
    [
        test "map"   (fun () -> map_iter   ~num_keys ~iterations);
        test "table" (fun () -> table_iter ~num_keys ~iterations)
    ]

let () =
    tests ~num_keys:1000 ~iterations:100_000
    |> Bench.make_command
    |> Command.run


Replace Core_kernel with Hh_prelude to forbid polymorphic equal in decl and typing

(*
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the "hack" directory of this source tree.
 *
 *)

include Core_kernel

(** The equality function in Pervasives is backed by compiler magic (called
    compare_val), which operates on the memory representation of values to
    perform a comparison between values of any type. This is convenient, but it
    has the wrong semantics for stdlib sets and maps (since the same value may
    be represented with trees of differing structure), will not compare on-heap
    values with off-heap values (unless the compiler was configured with the
    -no-naked-pointers option), and is slower than monomorphic comparison
    functions. As a result, we forbid the use of the = operator from Pervasives
    here.

    Instead of using polymorphic equality, use ppx_deriving to derive eq for
    your data type and use the derived `equal` function.

    If you are performing many comparisons of the same kind, consider binding
    the = operator locally with something like `let ( = ) = Int.equal`.

    If your module only compares values of a single builtin type (e.g., int or
    string), you can add `open Int.Replace_polymorphic_compare` to the top of
    the file. *)
let ( = ) : [ `Do_not_use_polymorphic_compare ] =
  `Do_not_use_polymorphic_compare

(** The nonequal function in Pervasives is backed by compiler magic (called
    compare_val), which operates on the memory representation of values to
    perform a comparison between values of any type. This is convenient, but it
    has the wrong semantics for stdlib sets and maps (since the same value may
    be represented with trees of differing structure), will not compare on-heap
    values with off-heap values (unless the compiler was configured with the
    -no-naked-pointers option), and is slower than monomorphic comparison
    functions. As a result, we forbid the use of the <> operator from Pervasives
    here.

    Instead of using polymorphic equality, use ppx_deriving to derive eq for
    your data type and use the derived `equal` function.

    If you are performing many comparisons of the same kind, consider binding
    the <> operator locally with something like `let ( <> ) = Int.( <> )`.

    If your module only compares values of a single builtin type (e.g., int or
    string), you can add `open Int.Replace_polymorphic_compare` to the top of
    the file. *)
let ( <> ) : [ `Do_not_use_polymorphic_compare ] =
  `Do_not_use_polymorphic_compare


Isolate a few types of Goptions in a pure .mli, solving a dep issue with ocamlbuild

(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(** Some types used in the generic option mechanism (Goption) *)

(** Placing them here in a pure interface avoid some dependency issues
    when compiling CoqIDE *)

type option_name = string list

type option_value =
  | BoolValue   of bool
  | IntValue    of int option
  | StringValue of string

type option_state = {
  opt_sync  : bool;
  opt_depr  : bool;
  opt_name  : string;
  opt_value : option_value;
}


let max_step = 256

let pi = 4. *. atan 1.

let rad_of_step x = (float_of_int x) *. 2. *. pi /. (float_of_int max_step)

let cos_step x = cos (rad_of_step x)
let sin_step x = sin (rad_of_step x)

let round x = int_of_float (x +. 0.5)

let fixval x = round (x *. (float_of_int (1 lsl 16)))

let string_of_char c = String.make 1 c

let hexstring_of_int ?(dollar = true) nb n =
  let s = ref "" and n = ref n in
    for i = 0 to nb-1 do
      let d = !n land 0xf in
        n := !n lsr 4;
        if (0 <= d) && (d <= 9) then s := (string_of_char (Char.chr (d+(Char.code '0'))))^(!s)
        else s := (string_of_char (Char.chr (d-10+(Char.code 'A'))))^(!s)
    done;
    (if dollar then "$" else "")^(!s)

let string_of_long x =
  let h = (x asr 16) land 0xffff
  and l = x land 0xffff
  in
    (hexstring_of_int 4 h)^(hexstring_of_int ~dollar:false 4 l)

let dc_print =
  let counter = ref 0 in
    function s ->
      if !counter = 0 then print_string "\tdc.l\t";
      print_string s;
      incr counter;
      counter := !counter mod 8;
      if !counter <> 0 then print_string ", "
      else print_newline ()

let _ =
  for i = 0 to max_step-1 do
    let v = fixval (cos_step i) in
      dc_print (string_of_long v);
  done


Add a script to automatically add dev-repos to the repo

#!/usr/bin/env opam-admin.top
#directory "+../opam";;
open Opam_admin_top;;

#use "topfind";;
#require "re";;

let github_re =
  Re.compile (Re_perl.re "https?://([^/]*github.com/.*)/archive/.*");;

map_packages_gen @@ fun nv ~opam ~descr ~url ~dot_install ->
let opam =
  if OpamFile.OPAM.dev_repo opam <> None then opam else
    match url with
    | None -> opam
    | Some u ->
        match OpamFile.URL.(kind u, url u) with
        | `http, (addr,None) when Re.execp github_re addr ->
            let substrings = Re.exec github_re addr in
            let git = Printf.sprintf "git://%s" (Re.get substrings 1) in
            OpamFile.OPAM.with_dev_repo opam (Some (OpamTypes.Git (git,None)))
        | _ -> opam
in
opam, descr, url, dot_install


Add test for short-paths in error messages

(* TEST
   flags = " -short-paths "
   * expect
*)

module M = struct type t = T end

type t = M.t

let x : M.t = S
[%%expect {|
module M : sig type t = T end
type t = M.t
Line 5, characters 14-15:
5 | let x : M.t = S
                  ^
Error: This variant expression is expected to have type M.t
       The constructor S does not belong to type M.t
|}]

module M = struct
  class c = object method foo = 3 end
end

type c = M.c

let () = (new M.c)#bar
[%%expect {|
module M : sig class c : object method foo : int end end
type c = M.c
Line 7, characters 9-18:
7 | let () = (new M.c)#bar
             ^^^^^^^^^
Error: This expression has type M.c
       It has no method bar
|}]


Scanf.scanf "%s %f %f\n" (fun _ b c ->
    Printf.printf "TOTAL = R$ %.2f\n" (b +. (c *. 0.15));
)


(*
 * Suppose that a variable word exists and is a string.
 * Define a variable sentence that uses 5 string concatenations to create a
 * string containing 9 times word, separated by commas.
 *)

let word = "foo";;

let x = word ^ ",";; (* One *)

let sentence =
  let x1 = x^x^x in  (* Three *)
  let x2 = x1^x1 in  (* Four *)
  x2^x1              (* Five *)
;;


module Documents.Receipt.View exposing (view)

import Html exposing (a, div, text, span)
import Html.Attributes exposing (href, target, class)
import Internationalization exposing (Language(..), TranslationId(..), translate)
import Material.Button as Button
import Material.Icon as Icon
import Material.Spinner as Spinner
import Documents.Receipt.Model exposing (Model)
import Documents.Receipt.Update exposing (Msg(Mdl, LoadUrl))

view : Model -> Html.Html Msg
view model =
    case model.url of
        Just url ->
            a
                [ href url, target "_blank", class "receipt view-receipt" ]
                [ Button.render
                    Mdl
                    [ 1 ]
                    model.mdl
                    [ Button.minifab ]
                    [ Icon.i "receipt"
                    , text (translate model.lang ReceiptAvailable)
                    ]
                ]

        Nothing ->
            if model.fetched then
                Button.render Mdl
                    [ 2 ]
                    model.mdl
                    [ Button.minifab
                    , Button.disabled
                    ]
                    [ Icon.i "receipt"
                    , text (translate model.lang ReceiptNotAvailable)
                    ]
            else if model.loading then
                Spinner.spinner [ Spinner.active True ]
            else
                span
                    [ class "receipt fetch-receipt" ]
                    [ Button.render Mdl
                        [ 0 ]
                        model.mdl
                        [ Button.minifab
                        , Button.onClick (LoadUrl model.reimbursement)
                        ]
                        [ Icon.i "search"
                        , text (translate model.lang ReceiptFetch)
                        ]
                    ]

Put class directly in button without adding extra span

module Documents.Receipt.View exposing (view)

import Html exposing (a, div, text)
import Html.Attributes exposing (href, target, class)
import Internationalization exposing (Language(..), TranslationId(..), translate)
import Material.Button as Button
import Material.Icon as Icon
import Material.Options as Options
import Material.Spinner as Spinner
import Documents.Receipt.Model exposing (Model)
import Documents.Receipt.Update exposing (Msg(Mdl, LoadUrl))

view : Model -> Html.Html Msg
view model =
    case model.url of
        Just url ->
            a
                [ href url, target "_blank", class "receipt view-receipt" ]
                [ Button.render
                    Mdl
                    [ 1 ]
                    model.mdl
                    [ Button.minifab ]
                    [ Icon.i "receipt"
                    , text (translate model.lang ReceiptAvailable)
                    ]
                ]

        Nothing ->
            if model.fetched then
                Button.render Mdl
                    [ 2 ]
                    model.mdl
                    [ Button.minifab
                    , Button.disabled
                    ]
                    [ Icon.i "receipt"
                    , text (translate model.lang ReceiptNotAvailable)
                    ]
            else if model.loading then
                Spinner.spinner [ Spinner.active True ]
            else
                Button.render Mdl
                    [ 0 ]
                    model.mdl
                    [ Button.minifab
                    , Button.onClick (LoadUrl model.reimbursement)
                    , Options.cs "receipt fetch-receipt"
                    ]
                    [ Icon.i "search"
                    , text (translate model.lang ReceiptFetch)
                    ]


module App where

import Html exposing (Html)

-- MODEL

type alias Artist =
  { id: Int
  , name: String
  }

type alias Model =
  List Artist

init : Model
init =
  []

-- UPDATE

type Action
  = NoOp

update : Action -> Model -> Model
update action model =
  case action of
    NoOp ->
      model

-- SIGNALS

main : Signal Html
main =
  Signal.map view model

model : Signal Model
model = Signal.foldp update init
        <| Signal.mergeMany [actions.signal]

actions : Signal.Mailbox Action
actions =
  Signal.mailbox NoOp

-- VIEW

view : Model -> Html
view model =
    Html.div [] [ Html.text "TODO" ]

Add json decoder for artist data

module App where

import Html exposing (Html)
import Json.Decode exposing ((:=))

-- MODEL

type alias Artist =
  { id: Int
  , name: String
  }

artist : Json.Decode.Decoder Artist
artist =
  Json.Decode.object2 Artist
    ("id" := Json.Decode.int)
    ("name" := Json.Decode.string)

type alias Model =
  List Artist

init : Model
init =
  []

-- UPDATE

type Action
  = NoOp

update : Action -> Model -> Model
update action model =
  case action of
    NoOp ->
      model

-- SIGNALS

main : Signal Html
main =
  Signal.map view model

model : Signal Model
model = Signal.foldp update init
        <| Signal.mergeMany [actions.signal]

actions : Signal.Mailbox Action
actions =
  Signal.mailbox NoOp

-- VIEW

view : Model -> Html
view model =
    Html.div [] [ Html.text "TODO" ]


module BoardHelpers exposing (..)

import Models exposing (..)

getBoardByStorageKey : List TrelloBoard -> String -> Maybe TrelloBoard
getBoardByStorageKey boards key =
    case getBoardIdByStorageKey key of
        Just id ->
            List.head (List.filter (\b -> b.id == id) boards)

        Nothing ->
            Nothing

getBoardIdByStorageKey : String -> Maybe String
getBoardIdByStorageKey key =
    case getBoardIdList key of
        Just s ->
            List.head s

        Nothing ->
            Nothing

getBoardIdList : String -> Maybe (List String)
getBoardIdList key =
    key
        |> String.split "-"
        |> List.tail

Add helper to get board by id

module BoardHelpers exposing (..)

import Models exposing (..)

getBoardByStorageKey : List TrelloBoard -> String -> Maybe TrelloBoard
getBoardByStorageKey boards key =
    case getBoardIdByStorageKey key of
        Just id ->
            getBoardById boards id

        Nothing ->
            Nothing

getBoardIdByStorageKey : String -> Maybe String
getBoardIdByStorageKey key =
    case getBoardIdList key of
        Just s ->
            List.head s

        Nothing ->
            Nothing

getBoardIdList : String -> Maybe (List String)
getBoardIdList key =
    key
        |> String.split "-"
        |> List.tail

getBoardById : List TrelloBoard -> String -> Maybe TrelloBoard
getBoardById boards id =
    List.head (List.filter (\b -> b.id == id) boards)


module Random.Pcg.Interop exposing (fission)

{-| Provides a function to create a PCG seed from a seed in the core library.
This is useful for library writers who need a splittable or most robust PRNG but
don't want to require client code to use the PCG implementation.

```elm
import Random
import Random.Pcg
import Random.Pcg.Interop as Random.Pcg
```

@docs fission
-}

import Random
import Random.Pcg

{-| Use the core library's random seed to produce a PCG random seed.

It seems that the package website doesn't show modules in type annotations, so here it is in full:

    fission : Random.Seed -> (Random.Pcg.Seed, Random.Seed)

-}
fission : Random.Seed -> ( Random.Pcg.Seed, Random.Seed )
fission stdSeed0 =
    let
        gen =
            Random.int 0 0xFFFFFFFF

        ( a, stdSeed1 ) =
            Random.step gen stdSeed0

        ( b, stdSeed2 ) =
            Random.step gen stdSeed1

        pcgSeed1 =
            Random.Pcg.initialSeed2 a b
    in
        ( pcgSeed1, stdSeed2 )

Change fission to be a generator

module Random.Pcg.Interop exposing (fission)

{-| Provides a function to create a PCG seed from a seed in the core library.
This is useful for library writers who need a splittable or most robust PRNG but
don't want to require client code to use the PCG implementation.

```elm
import Random
import Random.Pcg
import Random.Pcg.Interop as Random.Pcg
```

@docs fission
-}

import Random
import Random.Pcg

{-| Use the core library's random seed to produce a PCG random seed.

It seems that the package website doesn't show modules in type annotations, so here it is in full:

    fission : Random.Generator (Random.Pcg.Seed)

-}
fission : Random.Generator (Random.Pcg.Seed)
fission =
    Random.int 0 0xFFFFFFFF |> Random.map Random.Pcg.initialSeed


module Router.Input where

import History
import Router.Action exposing (Action(..))
import Action as RootAction exposing (Action(..))

input : Signal RootAction.Action
input =
  Signal.map (ActionRouter << PathChange) History.hash

Change location hash to history API.

module Router.Input where

import History
import Router.Action exposing (Action(..))
import Action as RootAction exposing (Action(..))

input : Signal RootAction.Action
input =
  Signal.map (ActionRouter << PathChange) History.path


import Time exposing (Time,second)
import Html exposing (Html,table,tr,td)
import Html.Attributes exposing(style,height,width)
import Random

import Matrix exposing (Matrix)

import Conway exposing (Cell(Alive,Dead))
import Neighbors exposing (neighborMap)

-- Model
type alias Model = Matrix Cell

cell : Bool -> Cell
cell b =
    if b then
        Alive
    else
        Dead

init : (Model, Cmd Msg)
init =
    let
        size = 100
        matrix = Matrix.square size <| always Dead
        matrixGenerator
            = Random.bool
            |> Random.map cell
            |> Random.list size
            |> Random.list size
            |> Random.map Matrix.fromList
    in
        (matrix, Random.generate Genesis matrixGenerator)

-- Messages
type Msg
    = Tick Time
    | Genesis (Matrix Cell)

-- View
view : Model -> Html Msg
view matrix =
    let
        innerMap = \cell ->
            case cell of
                Alive -> td [style [("backgroundColor", "black")]] []
                Dead -> td [style [("backgroundColor", "white")]] []

        outerMap = \row ->
            tr [] <| List.map innerMap row
    in
        table
            [ style
                [ ("table-layout", "fixed")
                , ("height", "800px")
                , ("width", "800px")
                ]
            ] <| List.map outerMap <| Matrix.toList matrix

-- Update
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Genesis matrix -> (matrix, Cmd.none)
        Tick _ -> (neighborMap Conway.apply model, Cmd.none)

-- Subscriptions
subscriptions : Model -> Sub Msg
subscriptions model =
    Time.every second Tick

-- Main
main : Program Never Model Msg
main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }

Remove all of the matrix specific/dependent code

import Time exposing (Time,second)
import Html exposing (Html,text)
import Set exposing (Set)

-- Model
type alias Location = (Int, Int)

type alias Model =
    { alive : List (Set Location)
    , width : Int
    , height : Int}

init : (Model, Cmd Msg)
init =
    ({alive = []
    , width = 10
    , height = 10}, Cmd.none)

-- Messages
type Msg
    = Tick Time

-- View
view : Model -> Html Msg
view matrix = text "banana"

-- Update
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Tick _ -> (model, Cmd.none)

-- Subscriptions
subscriptions : Model -> Sub Msg
subscriptions model =
    Time.every second Tick

-- Main
main : Program Never Model Msg
main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }


module Styles exposing (styleString)

styleString = """
span {
  background-color : #aaa;
}

main {
  background-color : #DADADA;
  color : #333;
}

.selectedLine {
  background-color: #ADADAD;
}

#cursor {
  background-color: red;
  height: 20px;
  width: 1em;
}

"""

Make the font actually monospaced.

module Styles exposing (styleString)

styleString =
    """
span {
  background-color : #aaa;
}

main {
  background-color : #DADADA;
  color : #333;
}

.selectedLine {
  background-color: #ADADAD;
}

#cursor {
  background-color: red;
  height: 20px;
  width: 1em;
}

* {
  font-family: monospace, 'Courier';
}

"""


module App exposing (..)

import Html exposing (Html, button, div, program, text)
import Html.Events exposing (onClick)

-- MODEL

type alias Model =
    Int

init : ( Model, Cmd Msg )
init =
    ( 0, Cmd.none )

-- MESSAGES

type Msg
    = Increment Int
    | Decrement Int

-- VIEW

view : Model -> Html Msg
view model =
    div []
        [ button [ onClick (Increment 10) ] [ text "+10" ]
        , div [] [ text (toString model) ]
        , button [ onClick (Decrement 10) ] [ text "-10" ]
        ]

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Increment n ->
            ( model + n, Cmd.none )

        Decrement n ->
            ( model - n, Cmd.none )

subscriptions : model -> Sub Msg
subscriptions model =
    Sub.none

main : Program Never Model Msg
main =
    program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }

Add my first subscriptions app

module Main exposing (..)

import Html exposing (Html, div, program, text)
import Mouse
import Keyboard

-- MODEL

type alias Model =
    Int

init : ( Model, Cmd Msg )
init =
    ( 0, Cmd.none )

-- MESSAGES

type Msg
    = MouseMsg Mouse.Position
    | KeyMsg Keyboard.KeyCode

-- VIEW

view : Model -> Html Msg
view model =
    div [] [ text (toString model) ]

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        MouseMsg positionMouse ->
            ( model + 1, Cmd.none )

        KeyMsg keyCodeKeyboard ->
            ( model + 2, Cmd.none )

subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ Mouse.downs MouseMsg
        , Keyboard.ups KeyMsg
        ]

main : Program Never Model Msg
main =
    program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }


port module Main exposing (..)

import Test.Runner.Node exposing (run, TestProgram)
import Json.Encode exposing (Value)
import Test exposing (..)
import Expect
import Accumulate exposing (accumulate)
import String

square : Int -> Int
square x =
    x * x

tests : Test
tests =
    describe "Accumulate"
        [ test "[]] Accumulate" <|
            \() -> Expect.equal [] (accumulate square [])
        , test "square Accumulate" <|
            \() -> Expect.equal [ 1, 4, 9 ] (accumulate square [ 1, 2, 3 ])
        , test "toUpper Accumulate" <|
            \() ->
                Expect.equal [ "HELLO", "WORLD" ]
                    (accumulate String.toUpper [ "hello", "world" ])
        , test "reverse Accumulate" <|
            \() ->
                Expect.equal [ "olleh", "dlrow" ]
                    (accumulate String.reverse [ "hello", "world" ])
        ]

main : TestProgram
main =
    run emit tests

port emit : ( String, Value ) -> Cmd msg

Fix accumulate test case description

port module Main exposing (..)

import Test.Runner.Node exposing (run, TestProgram)
import Json.Encode exposing (Value)
import Test exposing (..)
import Expect
import Accumulate exposing (accumulate)
import String

square : Int -> Int
square x =
    x * x

tests : Test
tests =
    describe "Accumulate"
        [ test "[] Accumulate" <|
            \() -> Expect.equal [] (accumulate square [])
        , test "square Accumulate" <|
            \() -> Expect.equal [ 1, 4, 9 ] (accumulate square [ 1, 2, 3 ])
        , test "toUpper Accumulate" <|
            \() ->
                Expect.equal [ "HELLO", "WORLD" ]
                    (accumulate String.toUpper [ "hello", "world" ])
        , test "reverse Accumulate" <|
            \() ->
                Expect.equal [ "olleh", "dlrow" ]
                    (accumulate String.reverse [ "hello", "world" ])
        ]

main : TestProgram
main =
    run emit tests

port emit : ( String, Value ) -> Cmd msg


module Parsing exposing (..)

-- External Imports

import Navigation
import UrlParser exposing (Parser, (</>), map, int, oneOf, s, string)
import String

-- Internal Imports

import Types exposing (Route(..))

-- Parsing

urlParser : Navigation.Location -> Route
urlParser location =
    let
        one =
            Debug.log "hash" location.hash
    in
        case UrlParser.parseHash routeParser location of
            Just route ->
                route

            Nothing ->
                NotFound

silencesParser : Parser a a
silencesParser =
    UrlParser.s "silences"

newSilenceParser : Parser a a
newSilenceParser =
    UrlParser.s "silences" </> UrlParser.s "new"

silenceParser : Parser (Int -> a) a
silenceParser =
    UrlParser.s "silences" </> UrlParser.int

editSilenceParser : Parser (Int -> a) a
editSilenceParser =
    UrlParser.s "silences" </> UrlParser.int </> UrlParser.s "edit"

alertsParser : Parser a a
alertsParser =
    UrlParser.s "alerts"

topLevelParser : Parser a a
topLevelParser =
    UrlParser.s ""

routeParser : Parser (Route -> a) a
routeParser =
    UrlParser.oneOf
        [ map SilencesRoute silencesParser
        , map NewSilenceRoute newSilenceParser
        , map EditSilenceRoute editSilenceParser
        , map SilenceRoute silenceParser
        , map AlertGroupsRoute alertsParser
        , map TopLevel topLevelParser
        ]

Remove logging of hash location

module Parsing exposing (..)

-- External Imports

import Navigation
import UrlParser exposing (Parser, (</>), map, int, oneOf, s, string)
import String

-- Internal Imports

import Types exposing (Route(..))

-- Parsing

urlParser : Navigation.Location -> Route
urlParser location =
    case UrlParser.parseHash routeParser location of
        Just route ->
            route

        Nothing ->
            NotFound

silencesParser : Parser a a
silencesParser =
    UrlParser.s "silences"

newSilenceParser : Parser a a
newSilenceParser =
    UrlParser.s "silences" </> UrlParser.s "new"

silenceParser : Parser (Int -> a) a
silenceParser =
    UrlParser.s "silences" </> UrlParser.int

editSilenceParser : Parser (Int -> a) a
editSilenceParser =
    UrlParser.s "silences" </> UrlParser.int </> UrlParser.s "edit"

alertsParser : Parser a a
alertsParser =
    UrlParser.s "alerts"

topLevelParser : Parser a a
topLevelParser =
    UrlParser.s ""

routeParser : Parser (Route -> a) a
routeParser =
    UrlParser.oneOf
        [ map SilencesRoute silencesParser
        , map NewSilenceRoute newSilenceParser
        , map EditSilenceRoute editSilenceParser
        , map SilenceRoute silenceParser
        , map AlertGroupsRoute alertsParser
        , map TopLevel topLevelParser
        ]


import Html exposing (..)
import Html.Events exposing (onClick)
import StartApp

main =
  StartApp.start { model = model, view = view, update = update }

model = ["first", "second"]

view address model =
  ul []
       (List.map (viewLayer address) model
        ++ [ button [ onClick address Remove ] [ text "-" ]
           , button [ onClick address Add ] [ text "+" ]
           ]
       )

viewLayer address layer =
  li []
     [ text layer ]

type Action = Add | Remove

update action model =
  case action of
    Add-> model
    Remove -> model

Remove individual layers from the list

import Html exposing (..)
import Html.Events exposing (onClick)
import StartApp

main =
  StartApp.start { model = init, view = view, update = update }

-- Model

type alias AppState =
  { nextID : Int
  , layers : List ( ID, String )
  }

type alias ID = Int

init : AppState
init =
  { layers = [(0, "one"), (1, "two")]
  , nextID = 2
  }

-- Views

view : Signal.Address Action -> AppState -> Html
view address model =
  div []
        [ ul []
             (List.map (viewLayer address) model.layers)
        , button [ onClick address Add ] [ text "+" ]
        ]

viewLayer : Signal.Address Action -> ( ID, String ) -> Html
viewLayer address (id, layer) =
  li []
     [ text layer
     , button [ onClick address (Remove id) ] [ text "x" ] ]

-- Actions

type Action
  = Add
  | Remove ID

update : Action -> AppState -> AppState
update action model =
  case action of
    Add -> { model | layers <- model.layers ++ [(model.nextID, "another")]
                   , nextID <- model.nextID + 1 }
    Remove id -> { model | layers <- List.filter (\(layerID, _) -> layerID /= id) model.layers }


module LeapTest where

-- TODO - remove example inclusion once Problem sets are ready to go live or CI is set up.

import LeapExample exposing (isLeap)

import ElmTest.Test exposing (test, Test, suite)
import ElmTest.Assertion exposing (assert, assertEqual)
import ElmTest.Runner.Element exposing (runDisplay)

tests : Test
tests = suite "Leap Test Suite"
        [ test "Yes, 1996 is a leap year" (assertEqual True (isLeap 1996)),
          test "No, 1997 is a leap year" (assertEqual False (isLeap 1997)),
          test "No, 1998 is a leap year" (assertEqual False (isLeap 1998)),
          test "No, 1900 is a leap year" (assertEqual False (isLeap 1900)),
          test "Yes, 2400 is a leap year" (assertEqual True (isLeap 2400))
        ]

main = runDisplay tests

Update to use assert instead of assertEqual on boolean tests

module LeapTest where

-- TODO - remove example inclusion once Problem sets are ready to go live or CI is set up.

import LeapExample exposing (isLeap)

import ElmTest.Test exposing (test, Test, suite)
import ElmTest.Assertion exposing (assert, assertEqual)
import ElmTest.Runner.Element exposing (runDisplay)

tests : Test
tests = suite "Leap Test Suite"
        [ test "Yes, 1996 is a leap year" (assert (isLeap 1996)),
          test "No, 1997 is a leap year" (assert (not (isLeap 1997))),
          test "No, 1998 is a leap year" (assert (not (isLeap 1998))),
          test "No, 1900 is a leap year" (assert (not (isLeap 1900))),
          test "Yes, 2400 is a leap year" (assert (isLeap 2400))
        ]

main = runDisplay tests


import Time exposing (Time,second)
import Html exposing (Html,text)
import Set exposing (Set)

-- Model
type alias Location = (Int, Int)

type alias Model =
    { alive : List (Set Location)
    , width : Int
    , height : Int}

init : (Model, Cmd Msg)
init =
    ({alive = []
    , width = 10
    , height = 10}, Cmd.none)

-- Messages
type Msg
    = Tick Time

-- View
view : Model -> Html Msg
view matrix = text "banana"

-- Update
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Tick _ -> (model, Cmd.none)

-- Subscriptions
subscriptions : Model -> Sub Msg
subscriptions model =
    Time.every second Tick

-- Main
main : Program Never Model Msg
main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }

Fix type of cell representation

import Time exposing (Time,second)
import Html exposing (Html,text)
import Set exposing (Set)

-- Model
type alias Coordinate = (Int, Int)

type alias Model =
    { alive : Set Coordinate
    , width : Int
    , height : Int}

init : (Model, Cmd Msg)
init =
    ({alive = Set.empty
    , width = 10
    , height = 10}, Cmd.none)

-- Messages
type Msg
    = Tick Time

-- View
view : Model -> Html Msg
view matrix = text "banana"

-- Update
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Tick _ -> (model, Cmd.none)

-- Subscriptions
subscriptions : Model -> Sub Msg
subscriptions model =
    Time.every second Tick

-- Main
main : Program Never Model Msg
main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }


module View exposing (root)

import Dict exposing (Dict)
import Html exposing (..)
import Html.App
import Html.Attributes exposing (..)

import Helpers
import Types exposing (..)

import Player.View
import User.Types
import User.View

root : Model -> Html Msg
root model =
  div [ class "container" ]
    [ div [ class "content" ]
       [ header []
           [ h1 [] [ text "Loops With Friends" ] ]
       , main' []
           [ Player.View.root (Helpers.playerUser model)
           , usersView (Helpers.otherUsers model)
           ]
       ]
    ]

usersView : User.Types.Collection -> Html Msg
usersView users =
  section []
    [ h2 [] [ text "Other Players' Loops" ]
    , ul [ class "grid-items" ]
        <| [ li [ class "grid-item placeholder" ] [] ]
        ++ (Dict.values users |> List.map User.View.root)
    ]

Add messaging for an empty jam

module View exposing (root)

import Dict exposing (Dict)
import Html exposing (..)
import Html.App
import Html.Attributes exposing (..)

import Helpers
import Types exposing (..)

import Player.View
import User.Types
import User.View

root : Model -> Html Msg
root model =
  div [ class "container" ]
    [ div [ class "content" ]
       [ header []
           [ h1 [] [ text "Loops With Friends" ] ]
       , main' []
           [ Player.View.root (Helpers.playerUser model)
           , usersView (Helpers.otherUsers model)
           ]
       ]
    ]

usersView : User.Types.Collection -> Html Msg
usersView users =
  if Dict.isEmpty users then
    h2 []
      [ text "There's no one else here right now. Tell your friends to join!" ]
  else
    section []
      [ h2 [] [ text "Other Players' Loops" ]
      , ul [ class "grid-items" ]
          <| [ li [ class "grid-item placeholder" ] [] ]
          ++ (Dict.values users |> List.map User.View.root)
      ]


module App.View exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)

import App.Types exposing (..)
import App.Input.View as Input
import App.Entries.View as Entries
import App.Control.View as Control

view : Model -> Html Msg
view model =
    div []
        [ title
        , Input.view model.input
        , Entries.view model.entries
        , Control.view model.control
        , infoFooter
        ]

title : Html Msg
title =
    header []
        [ h1 []
            [ a [ href "https://github.com/jackrzhang/lister-elm" ]
                [ text "lister"]
            ]
        ]

infoFooter : Html Msg
infoFooter =
    footer []
        [ p []
            [ text "Written by "
            , a [ href "https://github.com/jackrzhang" ] [ text "Jack Zhang" ]
            ]
        , p []
            [ text "Built with "
            , a [ href "http://elm-lang.org" ] [ text "Elm" ]
            ]
        ]

Hide Control if Entries list is empty

module App.View exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)

import App.Types exposing (..)
import App.Input.View as Input
import App.Entries.View as Entries
import App.Control.View as Control

view : Model -> Html Msg
view model =
    div []
        [ title
        , Input.view model.input
        , Entries.view model.entries
        , viewControl model
        , infoFooter
        ]

viewControl : Model -> Html Msg
viewControl model =
    if not (List.isEmpty model.entries.list) then
        Control.view model.control
    else
        div [] []

title : Html Msg
title =
    header []
        [ h1 []
            [ a [ href "https://github.com/jackrzhang/lister-elm" ]
                [ text "lister"]
            ]
        ]

infoFooter : Html Msg
infoFooter =
    footer []
        [ p []
            [ text "Written by "
            , a [ href "https://github.com/jackrzhang" ] [ text "Jack Zhang" ]
            ]
        , p []
            [ text "Built with "
            , a [ href "http://elm-lang.org" ] [ text "Elm" ]
            ]
        ]


module Main where

import Test
import Text
import Graphics.Element exposing (..)
import ElmTest.Run as Run
import ElmTest.Runner.Element as ElementRunner
import ElmTest.Runner.String  as StringRunner

plainText : String -> Element
plainText s =
    leftAligned (Text.fromString s)

prettyOut : Element
prettyOut =
    ElementRunner.runDisplay Test.suite3

uglyOut : String
uglyOut =
    StringRunner.runDisplay Test.suite2

uglyOut' : String
uglyOut' =
    StringRunner.runDisplay Test.suite3

main : Element
main =
    flow down
        [ plainText "All tests in this suite will pass:\n\n"
        , plainText uglyOut
        , plainText "\nThis suite has a failing test:\n\n"
        , plainText uglyOut'
        , plainText "\nThe Element runner:\n\n"
        , prettyOut
        ]

Update for new public API

module Main where

import Test
import Text
import Graphics.Element exposing (..)
import ElmTest exposing (..)

plainText : String -> Element
plainText s =
    leftAligned (Text.fromString s)

prettyOut : Element
prettyOut =
    elementRunner Test.suite3

uglyOut : String
uglyOut =
    stringRunner Test.suite2

uglyOut' : String
uglyOut' =
    stringRunner Test.suite3

main : Element
main =
    flow down
        [ plainText "All tests in this suite will pass:\n\n"
        , plainText uglyOut
        , plainText "\nThis suite has a failing test:\n\n"
        , plainText uglyOut'
        , plainText "\nThe Element runner:\n\n"
        , prettyOut
        ]


module Char.Extra where

{-| Extra functions for working with characters.

# Classification
@docs isWhitespace

-}

import String
import List

{-| True for ASCII whitesapce characters `\b\t\n\v\f\r` -}
isWhitespace : Char -> Bool
isWhitespace char =
  List.member char <| String.toList " \t\r\n\v\f"

Upgrade to new module syntax

module Char.Extra exposing (..)

{-| Extra functions for working with characters.

# Classification
@docs isWhitespace

-}

import String
import List

{-| True for ASCII whitesapce characters `\b\t\n\v\f\r`
-}
isWhitespace : Char -> Bool
isWhitespace char =
    List.member char <| String.toList " \t\x0D\n\x0B\x0C"


module HelloWorld exposing (..)

import Html exposing (Html)
import Svg exposing (Svg)
import OpenSolid.Core.Types exposing (..)
import OpenSolid.Core.Point2d as Point2d
import OpenSolid.BoundingBox.Types exposing (..)
import OpenSolid.Svg as Svg
import Svg.Attributes as Attributes

angles =
    [0..24] |> List.map (\index -> index * degrees 15)

firstPoint =
    Point2d ( 100, 0 )

pointAt angle =
    Point2d.rotateAround Point2d.origin angle firstPoint

points =
    List.map pointAt angles

svgPoint : Point2d -> Svg Never
svgPoint point =
    Svg.point2d [ Attributes.r "2", Attributes.fill "blue" ] point

pointsGroup : Svg Never
pointsGroup =
    Svg.g [] (List.map svgPoint points)

boundingBox : BoundingBox2d
boundingBox =
    BoundingBox2d { minX = -120, minY = -120, maxX = 120, maxY = 120 }

main : Html Never
main =
    Svg.scene2d boundingBox [ pointsGroup ]

Update test doc image to not use Svg.scene2d

module HelloWorld exposing (..)

import Html exposing (Html)
import Svg exposing (Svg)
import Svg.Attributes as Attributes
import OpenSolid.Core.Types exposing (..)
import OpenSolid.Core.Point2d as Point2d
import OpenSolid.Core.Frame2d as Frame2d
import OpenSolid.BoundingBox.Types exposing (..)
import OpenSolid.Svg as Svg
import Svg.Attributes as Attributes

angles =
    [0..24] |> List.map (\index -> index * degrees 15)

firstPoint =
    Point2d ( 100, 0 )

pointAt angle =
    Point2d.rotateAround Point2d.origin angle firstPoint

points =
    List.map pointAt angles

svgPoint : Point2d -> Svg Never
svgPoint point =
    Svg.point2d [ Attributes.r "2", Attributes.fill "blue" ] point

pointsGroup : Svg Never
pointsGroup =
    Svg.g [] (List.map svgPoint points)

topLeftFrame =
    Frame2d.at (Point2d ( -120, 120 )) |> Frame2d.flipY

main : Html Never
main =
    Svg.svg [ Attributes.width "240", Attributes.height "240" ]
        [ Svg.relativeTo topLeftFrame pointsGroup ]


module Update exposing
    ( init
    , update
    )

-------------------------
-- External dependencies
-------------------------
import Http
import Json.Decode as Json

-------------------------
-- Internal dependencies
-------------------------
import Model exposing ( .. )

init : ( AppState, Cmd Msg )
init = ( AppState "" 0, Cmd.none )

update : Msg -> AppState -> ( AppState, Cmd Msg )
update msg state =
    case msg of
        NoOp -> ( state, Cmd.none )
        UpdateQueryString newQueryString -> ( { state | queryString = newQueryString }, Cmd.none )
        SubmitQuery -> ( state, submitQuery state.queryString )
        QuerySucceed items -> ( state, Cmd.none )
        QueryFail error -> ( state, Cmd.none )

postApi : String
postApi = "https://public-api.wordpress.com/rest/v1.1/sites/isthisbaokaka.wordpress.com/posts"

submitQuery : String -> Cmd Msg
submitQuery queryString =
    let
        processResult result =
            case result of
                Ok items -> QuerySucceed items
                Err error -> QueryFail error
    in
        Http.send processResult ( Http.get postApi decodePostQueryResponse )

decodePostQueryResponse : Json.Decoder ( List String )
decodePostQueryResponse =
    Json.at [ "posts" ] ( Json.list Json.string )

Append the user input query to form the full search request

module Update exposing
    ( init
    , update
    )

-------------------------
-- External dependencies
-------------------------
import Http
import Json.Decode as Json

-------------------------
-- Internal dependencies
-------------------------
import Model exposing ( .. )

init : ( AppState, Cmd Msg )
init = ( AppState "" 0, Cmd.none )

update : Msg -> AppState -> ( AppState, Cmd Msg )
update msg state =
    case msg of
        NoOp -> ( state, Cmd.none )
        UpdateQueryString newQueryString -> ( { state | queryString = newQueryString }, Cmd.none )
        SubmitQuery -> ( state, submitQuery state.queryString )
        QuerySucceed items -> ( state, Cmd.none )
        QueryFail error -> ( state, Cmd.none )

postApi : String -> String
postApi query = "https://public-api.wordpress.com/rest/v1.1/sites/isthisbaokaka.wordpress.com/posts?fields=title&search=" ++ query

submitQuery : String -> Cmd Msg
submitQuery queryString =
    let
        processResult result =
            case result of
                Ok items -> QuerySucceed items
                Err error -> QueryFail error
    in
        Http.send processResult ( Http.get ( postApi queryString ) decodePostQueryResponse )

decodePostQueryResponse : Json.Decoder ( List String )
decodePostQueryResponse =
    Json.at [ "posts" ] ( Json.list Json.string )


module IV.View.AboutPage exposing (view)

import Html exposing (..)
import Html.Attributes exposing (..)

import IV.Msg exposing (Msg(..))
import IV.Pile.HtmlShorthand exposing (..)
import IV.View.Layout as Layout

view : Html Msg
view =
  row []

    [ Layout.headerWith []
    , p []
        [ text """
                This application is intended to be used by teachers and students.
                Any use of it in real medical situations is
                """
        , strong [] [text "at your own risk"]
        , text ". (See the scary legal boilerplate below.)"
        ]
    , p []
        [ text """
                The app is written in the Elm programming language and the source
                is freely available under the MIT License.
                """
        ]
    , hr [] []
    , p []
        [ text "Copyright © 2016 Brian Marick" ]
    , p []
        [ text """
                THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
                EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
                OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
                NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
                HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
                WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
                FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
                OTHER DEALINGS IN THE SOFTWARE.
                """
        ]
    , Layout.footerWith (span [] []) Layout.defaultFooterNav
    ]

Add links to About page

module IV.View.AboutPage exposing (view)

import Html exposing (..)
import Html.Attributes exposing (..)

import IV.Msg exposing (Msg(..))
import IV.Pile.HtmlShorthand exposing (..)
import IV.View.Layout as Layout

view : Html Msg
view =
  row []

    [ Layout.headerWith []
    , p []
        [ text """
                This application is intended to be used by teachers and students.
                Any use of it in real medical situations is
                """
        , strong [] [text "at your own risk"]
        , text ". (See the scary legal boilerplate below.)"
        ]
    , p []
        [ text "The app is written in the "
        , a [ href "http://elm-lang.org"]
            [ text "Elm programming language" ]
        , text " and the source is "
        , a [ href "https://github.com/marick/eecrit/tree/master/web/elm/IV" ]
            [ text "freely available" ]
        , text " under the "
        , a [ href "https://en.wikipedia.org/wiki/MIT_License" ]
            [ text "MIT License"]
        , text "."
        ]
    , hr [] []
    , p []
        [ text "Copyright © 2016 Brian Marick" ]
    , p []
        [ text """
                THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
                EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
                OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
                NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
                HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
                WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
                FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
                OTHER DEALINGS IN THE SOFTWARE.
                """
        ]
    , Layout.footerWith (span [] []) Layout.defaultFooterNav
    ]


module Parser (toParseTree) where

import Tokenizer exposing (Token(..), toTokens)

type ParseTree
    = Node (Token, List ParseTree)
    | LeafNode Token

toParseTree : String -> String
toParseTree input =
    let
        tokens = Debug.log "tokens" (Tokenizer.toTokens input)
        parseTree = Debug.log "parse tree" (parseFeature tokens)
    in
        input

parseFeature : List Token -> ParseTree
parseFeature tokens =
    case tokens of
        Samedent :: tks -> parseFeature tks
        Feature :: tks ->
            let
                (tks', desc) = descriptions tks
                -- (scen, tks'') = scenarios tks'
            in
                Node (Feature, desc)
        _ -> Node (Samedent, [])

descriptions : List Token -> (List Token, List ParseTree)
descriptions tokens =
    case tokens of
        Samedent :: NoBlock :: tks -> descriptions tks
        (Description str) :: tks ->
            let
                node = LeafNode (Description str)
                (tks', pts) = descriptions tks
            in
                (tks', node :: pts)
        _ -> (tokens, [])

Fix weird behavior when parsing descriptions

module Parser (toParseTree) where

import Tokenizer exposing (Token(..), toTokens)

type ParseTree
    = Node (Token, List ParseTree)
    | LeafNode Token

toParseTree : String -> String
toParseTree input =
    let
        tokens = Debug.log "tokens" (Tokenizer.toTokens input)
        parseTree = Debug.log "parse tree" (parseFeature tokens)
    in
        input

parseFeature : List Token -> ParseTree
parseFeature tokens =
    case tokens of
        Samedent :: tks -> parseFeature tks
        Feature :: (Description str) :: tks ->
            let
                d = LeafNode (Description str)
                (tks', desc) = dropIndent tks |> descriptions
                -- (scen, tks'') = scenarios tks'
            in
                Node (Feature, d :: desc)
        _ -> Node (Samedent, [])

descriptions : List Token -> (List Token, List ParseTree)
descriptions tokens =
    case tokens of
        Samedent :: tks -> descriptions tks
        NoBlock :: tks -> descriptions tks
        (Description str) :: tks ->
            let
                node = LeafNode (Description str)
                (tks', pts) = descriptions tks
            in
                (tks', node :: pts)
        _ -> (tokens, [])

dropIndent : List Token -> List Token
dropIndent tokens =
    case tokens of
        Indent :: ts -> dropIndent ts
        _ -> tokens


module BinarySearch exposing (..)

findNumber : List Int -> Int -> Bool
findNumber numbers number =
  case numbers of
    [] -> False
    [n] ->
      let
        _ = Debug.log "guess" 1
      in
        n == number
    _ ->
      let
        middleIndex = List.length numbers // 2
        firstHalf = List.take middleIndex numbers
        lastHalf = List.drop middleIndex numbers
        _ = Debug.log "guess" 1
      in
        if List.member number firstHalf then
          findNumber firstHalf number
        else
          findNumber lastHalf number

Fix implementation so it only searches once/iteration

module BinarySearch exposing (..)

-- There is an issue searching a list bigger than ~10000
-- because not tail recursive
-- RangeError: Maximum call stack size exceeded
findNumber : List Int -> Int -> Bool
findNumber numbers numberToFind =
  let
    middleIndex = List.length numbers // 2
    firstHalf = List.take middleIndex numbers
    lastHalf = List.drop middleIndex numbers
    _ = Debug.log "guess" 1
  in
    case List.head lastHalf of
        Just(middleElement) ->
            if numberToFind == middleElement then
              True
            else if numberToFind < middleElement then
              findNumber firstHalf numberToFind
            else
              findNumber lastHalf numberToFind
        Nothing -> False


import Html exposing (..)
import Html.Attributes exposing (..)
import String

import Center
import TopBar
import Outline

main =
  div []
    [ TopBar.topBar "docs"
    , Center.markdown "600px" directions
    , div [ Center.style "600px" ]
        [ h1 [id "complete-guide"] [text "Complete Guide"]
        , ul [class "guide content"] (List.map viewChapter Outline.outline)
        ]
    ]

directions = """

# Documentation

### Quick Start

  * [For JS users](/docs/from-javascript)
  * [Make an HTML app](https://github.com/evancz/start-app)
  * [Make Pong](/blog/making-pong)

### References

  * [Syntax](/docs/syntax)
  * [Core Libraries](http://package.elm-lang.org/packages/elm-lang/core/latest/)
  * [Community Packages](http://package.elm-lang.org)

"""

viewChapter : (String, List String) -> Html
viewChapter (title, sections) =
  li []
    [ a [href ("/guide/" ++ format title)] [text title]
    , ul [] (List.map (\name -> li [] [ text name ]) sections)
    ]

format str =
  String.toLower str
    |> String.map (\c -> if c == ' ' then '-' else c)

Add a spot for the style guide

import Html exposing (..)
import Html.Attributes exposing (..)
import String

import Center
import TopBar
import Outline

main =
  div []
    [ TopBar.topBar "docs"
    , Center.markdown "600px" directions
    , div [ Center.style "600px" ]
        [ h1 [id "complete-guide"] [text "Complete Guide"]
        , ul [class "guide content"] (List.map viewChapter Outline.outline)
        ]
    ]

directions = """

# Documentation

### Quick Start

  * [For JS users](/docs/from-javascript)
  * [Make an HTML app](https://github.com/evancz/start-app)
  * [Make Pong](/blog/making-pong)

### References

  * [Syntax](/docs/syntax)
  * [Style Guide](/docs/style-guide)
  * [Core Libraries](http://package.elm-lang.org/packages/elm-lang/core/latest/)
  * [Community Packages](http://package.elm-lang.org)

"""

viewChapter : (String, List String) -> Html
viewChapter (title, sections) =
  li []
    [ a [href ("/guide/" ++ format title)] [text title]
    , ul [] (List.map (\name -> li [] [ text name ]) sections)
    ]

format str =
  String.toLower str
    |> String.map (\c -> if c == ' ' then '-' else c)


module Components.Decoder exposing (decoder)

import Json.Decode exposing (Decoder, list, andThen, succeed)
import Components.Model exposing (..)
import Component.Decoder
import Component.Model

decoder : Decoder Model
decoder =
    list Component.Decoder.decoder |> andThen decodeModel

decodeModel : List Component.Model.Model -> Decoder Model
decodeModel componentList =
    succeed (Model componentList)

Add LOTS of function just to get groupWhile. So sorry.

module Components.Decoder exposing (decoder)

import Json.Decode exposing (Decoder, list, andThen, succeed)
import Components.Model exposing (..)
import Component.Decoder
import Component.Model

decoder : Decoder Model
decoder =
    list Component.Decoder.decoder |> andThen decodeModel

decodeModel : List Component.Model.Model -> Decoder Model
decodeModel componentList =
    succeed (Model componentList)
partitionEnv : List Component.Model.Model -> Environment
partitionEnv ls =
    case List.head ls of
        Just component ->
            Environment component.environment ls

        Nothing ->
            Environment "Unknown" ls

groupWhile : (a -> a -> Bool) -> List a -> List (List a)
groupWhile fn ls =
    case ls of
        [] ->
            []

        x :: xs ->
            let
                ( ys, zs ) =
                    span (fn x) xs
            in
                (x :: ys) :: groupWhile fn zs

span : (a -> Bool) -> List a -> ( List a, List a )
span p xs =
    ( takeWhile p xs, dropWhile p xs )

env : Component.Model.Model -> Component.Model.Model -> Bool
env a b =
    a.environment == b.environment

takeWhile : (a -> Bool) -> List a -> List a
takeWhile predicate list =
    case list of
        [] ->
            []

        x :: xs ->
            if (predicate x) then
                x :: takeWhile predicate xs
            else
                []

dropWhile : (a -> Bool) -> List a -> List a
dropWhile predicate list =
    case list of
        [] ->
            []

        x :: xs ->
            if (predicate x) then
                dropWhile predicate xs
            else
                list


module Json.Static where

import JavaScript as JS
import Native.Json as Native

fromJSString = Native.recordFromJSString
fromString s = Native.recordFromJSString (JS.fromString s)

toString r = JS.toString (Native.recordToPrettyJSString "" r)
toPrettyString sep r = JS.toString (Native.recordToPrettyJSString sep r)
toJSString r = Native.recordToPrettyJSString "" r

Switch the order of two functions.

module Json.Static where

import JavaScript as JS
import Native.Json as Native

fromString s = Native.recordFromJSString (JS.fromString s)
fromJSString = Native.recordFromJSString

toString r = JS.toString (Native.recordToPrettyJSString "" r)
toPrettyString sep r = JS.toString (Native.recordToPrettyJSString sep r)
toJSString r = Native.recordToPrettyJSString "" r


module Main exposing (..)

import Html exposing (text)

foo = ["one", "two", 2]

main =
    text <| foo

Define alias and print list

module Main exposing (..)

import Html exposing (text)

type alias Person =
    { name: String
    , age: Int
    }

people =
    [ { name = "Legolas", age = 2931}
    , { name = "Gimli", age = 139 }
    ]

main =
    text <| toString <| people


import Html exposing (..)
import Html.Attributes exposing (..)
import String

import Center
import TopBar
import Outline

main =
  div []
    [ TopBar.topBar "docs"
    , Center.markdown "600px" directions
    , div [ Center.style "600px" ]
        [ h1 [id "complete-guide"] [text "Complete Guide"]
        , ul [class "guide content"] (List.map viewChapter Outline.outline)
        ]
    ]

directions = """

# Documentation

### Quick Start

  * [Reading Elm code](/)
  * [Building widgets](https://github.com/evancz/elm-architecture-tutorial/)
  * [Making Pong](/)

### References

  * [Syntax](/docs/syntax)
  * [Core Libraries](http://package.elm-lang.org/packages/elm-lang/core/latest/)
  * [Community Packages](http://package.elm-lang.org)

"""

viewChapter : (String, List String) -> Html
viewChapter (title, sections) =
  li []
    [ a [href ("/guide/" ++ format title)] [text title]
    , ul [] (List.map (\name -> li [] [ text name ]) sections)
    ]

format str =
  String.toLower str
    |> String.map (\c -> if c == ' ' then '-' else c)

Improve "Quick Start" section a bit

import Html exposing (..)
import Html.Attributes exposing (..)
import String

import Center
import TopBar
import Outline

main =
  div []
    [ TopBar.topBar "docs"
    , Center.markdown "600px" directions
    , div [ Center.style "600px" ]
        [ h1 [id "complete-guide"] [text "Complete Guide"]
        , ul [class "guide content"] (List.map viewChapter Outline.outline)
        ]
    ]

directions = """

# Documentation

### Quick Start

  * [For JS users](/docs/from-javascript)
  * [Make an HTML app](https://github.com/evancz/start-app)
  * [Make Pong](/blog/making-pong)

### References

  * [Syntax](/docs/syntax)
  * [Core Libraries](http://package.elm-lang.org/packages/elm-lang/core/latest/)
  * [Community Packages](http://package.elm-lang.org)

"""

viewChapter : (String, List String) -> Html
viewChapter (title, sections) =
  li []
    [ a [href ("/guide/" ++ format title)] [text title]
    , ul [] (List.map (\name -> li [] [ text name ]) sections)
    ]

format str =
  String.toLower str
    |> String.map (\c -> if c == ' ' then '-' else c)


module ViewHelpers exposing (..)

import Basics.Extra exposing ((=>))
import Html exposing (..)
import Html.Attributes as Attr exposing (href, id, placeholder, src, style, target, title, type_, value)
import Html.Events exposing (onClick)
import Roster.Presenter
import StylesheetHelper exposing (CssClasses(..), class, classList, id)

blockButton : String -> msg -> String -> String -> Html msg
blockButton displayText onClickMsg tooltipText buttonId =
    div [ Attr.class "row", style [ "padding-bottom" => "1.333em" ] ]
        [ button
            [ onClick onClickMsg
            , Attr.class "btn btn-info btn-lg btn-block"
            , class [ LargeButtonText, BufferTop, TooltipContainer, Title ]
            , Attr.id buttonId
            ]
            [ div [] [ text displayText ]
            , div [ class [ Tooltip ] ] [ text tooltipText ]
            ]
        ]

roleIconView : Maybe Roster.Presenter.Role -> Html msg
roleIconView role =
    let
        roleIconClass =
            case role of
                Just Roster.Presenter.Driver ->
                    "driver-icon"

                Just Roster.Presenter.Navigator ->
                    "navigator-icon"

                Nothing ->
                    "no-role-icon"

        iconClassString =
            "role-icon " ++ roleIconClass
    in
    span [ Attr.class iconClassString ] []

Remove unnecessary bootstrap row wrapper.

module ViewHelpers exposing (..)

import Html exposing (..)
import Html.Attributes as Attr exposing (href, id, placeholder, src, style, target, title, type_, value)
import Html.Events exposing (onClick)
import Roster.Presenter
import StylesheetHelper exposing (CssClasses(..), class, classList, id)

blockButton : String -> msg -> String -> String -> Html msg
blockButton displayText onClickMsg tooltipText buttonId =
    button
        [ onClick onClickMsg
        , Attr.class "btn btn-info btn-lg btn-block"
        , class [ LargeButtonText, BufferTop, TooltipContainer, Title ]
        , Attr.id buttonId
        ]
        [ div [] [ text displayText ]
        , div [ class [ Tooltip ] ] [ text tooltipText ]
        ]

roleIconView : Maybe Roster.Presenter.Role -> Html msg
roleIconView role =
    let
        roleIconClass =
            case role of
                Just Roster.Presenter.Driver ->
                    "driver-icon"

                Just Roster.Presenter.Navigator ->
                    "navigator-icon"

                Nothing ->
                    "no-role-icon"

        iconClassString =
            "role-icon " ++ roleIconClass
    in
    span [ Attr.class iconClassString ] []


module Main (..) where

ratio =
    graphHeight
        / ( if range == 0 then
              0.1
            else
              toFloat range
          )

myTuple =
    (,,,)
        {- yes, this is valid! -} 1
        2
        3
        4

foo =
    ( case x of
        True ->
            1
        False ->
            3
    )

bar =
    ( if
        if a then
            True
        else
            False
      then
        "a"
      else
        "b"
    )

multilineList =
    [ 1
    , 2
    , 3
    ]

Add blankline between case branches


import Graphics.Element exposing (Element)
import ElmTest exposing (elementRunner, suite, test, assertEqual)

(<-*->): Int -> Int -> Int
(<-*->) x y =
  2 * x + y

(>*<): Int -> Int -> Int
(>*<) x y =
  2 * x + y

infix 8 <-*->
infix 2 >*<

main : Element
main =
  elementRunner <| suite "Test own operators with precedence"
    [ test "high" ((8 * 3 <-*-> 5) `assertEqual` 88)  -- 8*(2*3+5)
    , test "low" ((8 * 3 >*< 5) `assertEqual` 53)     -- 2*(8*2)+5
    ]

Use application operator in tests

import Graphics.Element exposing (Element)
import ElmTest exposing (elementRunner, suite, test, assertEqual)

(<-*->): Int -> Int -> Int
(<-*->) x y =
  2 * x + y

(>*<): Int -> Int -> Int
(>*<) x y =
  2 * x + y

infix 8 <-*->
infix 2 >*<

main : Element
main =
  elementRunner <| suite "Test own operators with precedence"
    [ test "high" <| (8 * 3 <-*-> 5) `assertEqual` 88  -- 8*(2*3+5)
    , test "low" <| (8 * 3 >*< 5) `assertEqual` 53     -- 2*(8*2)+5
    ]


module Views.BreakProgress exposing (view)

import Break
import Element exposing (Device)
import Element.Attributes as Attr
import Element.Events
import Setup.Msg as Msg
import Setup.Settings as Settings
import Styles exposing (StyleElement)

circleView : { model | device : Device } -> Styles.CircleFill -> StyleElement
circleView { device } circleFill =
    let
        width =
            Styles.responsiveForWidth device ( 6, 20 ) |> Attr.px

        height =
            Styles.responsiveForWidth device ( 10, 25 ) |> Attr.px
    in
    Element.el (Styles.Circle circleFill) [ Attr.width width, Attr.height height ] Element.empty

view : { model | intervalsSinceBreak : Int, settings : Settings.Data, device : Device } -> Styles.StyleElement
view ({ intervalsSinceBreak, settings } as model) =
    let
        remainingIntervals =
            Break.timersBeforeNext intervalsSinceBreak settings.intervalsPerBreak

        intervalBadges =
            List.range 1 settings.intervalsPerBreak
                |> List.map (\index -> index > intervalsSinceBreak)
                |> List.map
                    (\incompleteInterval ->
                        if incompleteInterval then
                            circleView model Styles.Hollow
                        else
                            circleView model Styles.Filled
                    )
    in
    Element.row
        Styles.None
        [ Attr.spacing 0
        , Element.Events.onClick Msg.ResetBreakData
        ]
        intervalBadges

Adjust break intervals remain dimensions.

module Views.BreakProgress exposing (view)

import Break
import Element exposing (Device)
import Element.Attributes as Attr
import Element.Events
import Setup.Msg as Msg
import Setup.Settings as Settings
import Styles exposing (StyleElement)

circleView : { model | device : Device } -> Styles.CircleFill -> StyleElement
circleView { device } circleFill =
    let
        width =
            Styles.responsiveForWidth device ( 6, 25 ) |> Attr.px

        height =
            Styles.responsiveForWidth device ( 10, 32 ) |> Attr.px
    in
    Element.el (Styles.Circle circleFill) [ Attr.width width, Attr.height height ] Element.empty

view : { model | intervalsSinceBreak : Int, settings : Settings.Data, device : Device } -> Styles.StyleElement
view ({ intervalsSinceBreak, settings } as model) =
    let
        remainingIntervals =
            Break.timersBeforeNext intervalsSinceBreak settings.intervalsPerBreak

        intervalBadges =
            List.range 1 settings.intervalsPerBreak
                |> List.map (\index -> index > intervalsSinceBreak)
                |> List.map
                    (\incompleteInterval ->
                        if incompleteInterval then
                            circleView model Styles.Hollow
                        else
                            circleView model Styles.Filled
                    )
    in
    Element.row
        Styles.None
        [ Attr.spacing 0
        , Element.Events.onClick Msg.ResetBreakData
        ]
        intervalBadges


module Presentation.Subscriptions exposing (presentationSubscriptions)

import Keyboard
import WebSocket

import Presentation.Types exposing (Model, Mode(..), Msg(..))

keyToMsg : Int -> Msg
keyToMsg code =
  case code of
    39 -> Next
    37 -> Previous
    _  -> Noop

broadCastEndpoint : String
broadCastEndpoint = "ws://localhost:9000"

presentationSubscriptions : Model -> Sub Msg
presentationSubscriptions model =
  case model.mode of
    Presenting -> Sub.batch
      [ Keyboard.presses keyToMsg
      , WebSocket.listen broadCastEndpoint NewMessage
      ]

Use 'downs' instead of 'presses' for keyboard navigation

module Presentation.Subscriptions exposing (presentationSubscriptions)

import Keyboard
import WebSocket

import Presentation.Types exposing (Model, Mode(..), Msg(..))

keyToMsg : Int -> Msg
keyToMsg code =
  case code of
    39 -> Next
    37 -> Previous
    _  -> Noop

broadCastEndpoint : String
broadCastEndpoint = "ws://localhost:9000"

presentationSubscriptions : Model -> Sub Msg
presentationSubscriptions model =
  case model.mode of
    Presenting -> Sub.batch
      [ Keyboard.downs keyToMsg
      , WebSocket.listen broadCastEndpoint NewMessage
      ]


module Graphics.ObjParser where

{-| General types used in loading of OBJ files.

@docs  toModel, toEntity, emptyModel

-}

import String
import Array
import Http

import Math.Vector3 (..)
import Math.Matrix4 (..)
import Graphics.WebGL (..)

import Graphics.ObjParserInternal as Internal

import Graphics.ObjTypes (..)

{-|
 Given an the string of an OBJ file and material options, convert it to a model
 -}
toModel : String -> MaterialData -> Model
toModel = Internal.toModel

{-|
 Given an model and values for uniform variables (i.e. model transformation matrix, camera view matrix, lighting information),
 create an entity which can be rendered using `webgl`
 -}
 --TODO update
toEntity : Model -> ObjectProperties -> GlobalProperties -> Entity
toEntity = Internal.toEntity

{-|
A default model with no triangles
-}
emptyModel : Model
emptyModel = EmptyModel

Add render to exposed functions, hide toEntity

module Graphics.ObjParser where

{-| General types used in loading of OBJ files.

@docs  toModel, render, emptyModel

-}

import String
import Array
import Http

import Math.Vector3 (..)
import Math.Matrix4 (..)
import Graphics.WebGL (..)

import Graphics.ObjParserInternal as Internal

import Graphics.ObjTypes (..)

{-|
 Given an the string of an OBJ file and material options, convert it to a model
 -}
toModel : String -> MaterialData -> Model
toModel = Internal.toModel

{-|
 Given an model and values for uniform variables (i.e. model transformation matrix, camera view matrix, lighting information),
 create an entity which can be rendered using `webgl`
 -}
 --TODO update
toEntity : Model -> ObjectProperties -> GlobalProperties -> Entity
toEntity = Internal.toEntity

{-|
A default model with no triangles
-}
emptyModel : Model
emptyModel = EmptyModel

{-|
Given a list of models and their properties, and the global properties for a scene,
render it into the actual WebGL element which can be placed in an HTML page.
-}
render : [(Model, ObjectProperties)] -> GlobalProperties -> Element
render = Internal.render


module IdeaFight.Compete exposing (Model, Msg, init, update, subscriptions, view)

import IdeaFight.Shuffle as Shuffle

import Html.App as App
import Html exposing (Html, text)

import Random
import String

type alias Model = List String
type Msg = ShuffledContents (List String)

init : String -> (Model, Cmd Msg)
init contents =
  let lines = String.lines contents
  in ([], Random.generate ShuffledContents <| Shuffle.shuffle lines)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    ShuffledContents contents -> (contents, Cmd.none)

subscriptions : Model -> Sub Msg
subscriptions _ = Sub.none

view : Model -> Html Msg
view model = text <| toString model

Add main to compete subapp for testing

module IdeaFight.Compete exposing (Model, Msg, init, update, subscriptions, view)

import IdeaFight.Shuffle as Shuffle

import Html.App as App
import Html exposing (Html, text)

import Random
import String

type alias Model = List String
type Msg = ShuffledContents (List String)

init : String -> (Model, Cmd Msg)
init contents =
  let lines = String.lines contents
  in ([], Random.generate ShuffledContents <| Shuffle.shuffle lines)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    ShuffledContents contents -> (contents, Cmd.none)

subscriptions : Model -> Sub Msg
subscriptions _ = Sub.none

view : Model -> Html Msg
view model = text <| toString model

main : Program Never
main = App.program {
    init = init "one\ntwo\nthree\nfour\nfive\nsix\nseven\neight",
    update = update,
    subscriptions = subscriptions,
    view = view
  }


import Markdown
import Message exposing (report)

main = report <| Markdown.toElement """

# Elm 0.15 alpha

Check out the change logs:

  * Very rough draft announcement
  *
    Changes to compiler / syntax
  *
    Changes to the core libraries

Here are some example programs:

  * Zip Code Lookup
  * Flickr Search

"""

Use a more realistic try message

import Markdown
import Message exposing (report)

main = report <| Markdown.toElement """

# Online Editor

Write and compile code online!

  * Hello World!
  * Mouse
  * Clock

For more guidance check out:

  * More examples
  * Learning resources

Here are the example programs for 0.15:

  * Zip Code Lookup
  * Flickr Search

"""


module Server.Update exposing (update)

import Http
import Task
import User
import Server.Json as Json
import Server.State exposing (..)
import Auth.State exposing (AuthCredentials)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Register state ->
            ( { model | status = RequestInProgress }
            , doRegister state
            )

        Login state ->
            ( { model | status = RequestInProgress }
            , doLogin state
            )

        AuthSuccess user ->
            ( { model | token = Just user.token, status = None }
            , Cmd.none
            )

        LoginFail error ->
            ( { model | status = Error "Unable to login" }
            , Cmd.none
            )

        RegisterFail error ->
            ( { model | status = Error "Unable to register" }
            , Cmd.none
            )

doRegister : AuthCredentials -> Cmd Msg
doRegister =
    doAuth "//localhost:3000/users" RegisterFail

doLogin : AuthCredentials -> Cmd Msg
doLogin =
    doAuth "TODO" LoginFail

doAuth : String -> (Http.Error -> Msg) -> AuthCredentials -> Cmd Msg
doAuth url msg state =
    { verb = "POST"
    , url = url
    , headers = headers
    , body = Http.string (Json.auth state)
    }
        |> Http.send Http.defaultSettings
        |> Http.fromJson User.fromAuthJson
        |> Task.perform msg AuthSuccess

headers : List ( String, String )
headers =
    [ ( "Content-Type", "application/json" )
    , ( "Accept", "application/json" )
    ]

Use correct register URL in client

module Server.Update exposing (update)

import Http
import Task
import User
import Server.Json as Json
import Server.State exposing (..)
import Auth.State exposing (AuthCredentials)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Register state ->
            ( { model | status = RequestInProgress }
            , doRegister state
            )

        Login state ->
            ( { model | status = RequestInProgress }
            , doLogin state
            )

        AuthSuccess user ->
            ( { model | token = Just user.token, status = None }
            , Cmd.none
            )

        LoginFail error ->
            ( { model | status = Error "Unable to login" }
            , Cmd.none
            )

        RegisterFail error ->
            ( { model | status = Error "Unable to register" }
            , Cmd.none
            )

doRegister : AuthCredentials -> Cmd Msg
doRegister =
    doAuth "//localhost:3000/register" RegisterFail

doLogin : AuthCredentials -> Cmd Msg
doLogin =
    doAuth "TODO" LoginFail

doAuth : String -> (Http.Error -> Msg) -> AuthCredentials -> Cmd Msg
doAuth url msg state =
    { verb = "POST"
    , url = url
    , headers = headers
    , body = Http.string (Json.auth state)
    }
        |> Http.send Http.defaultSettings
        |> Http.fromJson User.fromAuthJson
        |> Task.perform msg AuthSuccess

headers : List ( String, String )
headers =
    [ ( "Content-Type", "application/json" )
    , ( "Accept", "application/json" )
    ]


module AllSyntax where

import String
import Signal exposing (foldp, map)
import Json.Decode as Json
import List exposing (..)

fn =
    "XYZZY"

annotatedFn : String
annotatedFn =
    "XYZZY"

inlinePipeline =
    1 |> (+) 2

tuple =
    (1, 2)

commentedLiterals =
    ({- int -} 1, {- float -} 0.1, {- char -} 'c', {- string -} "str", {- boolean -} True)

infixOperator =
    1 + 2 * 3 / 4 // 5 |> (+) 0

unaryOperator a =
    -(1) + -2 + -a

functionWithParam a =
    a

functionParameters a (t,s,_,(t',{x',y'})) {x,y} _ =
    ()

fnAsLambda =
    (\a -> a)

fnAsUnparenthesizedLambda =
    \arg -> arg

multiArgLambda =
    \a b (t,s) {x,y} _ -> \c -> (\d -> ())

parenthesizedExpressions =
    (1 + (2 * 3) / 4) |> ((+) 0)

Add more thorough tests for function/lambda arguments

module AllSyntax where

import String
import Signal exposing (foldp, map)
import Json.Decode as Json
import List exposing (..)

fn =
    "XYZZY"

annotatedFn : String
annotatedFn =
    "XYZZY"

inlinePipeline =
    1 |> (+) 2

tuple =
    (1, 2)

commentedLiterals =
    ({- int -} 1, {- float -} 0.1, {- char -} 'c', {- string -} "str", {- boolean -} True)

infixOperator =
    1 + 2 * 3 / 4 // 5 |> (+) 0

unaryOperator a =
    -(1) + -2 + -a

functionWithParam a =
    a

functionParameters a b (t,s,_,(t',s',_,(t'',s''),{x',y'})) {x,y} _ =
    ()

fnAsLambda =
    (\a -> a)

fnAsUnparenthesizedLambda =
    \arg -> arg

multiArgLambda =
    \a b (t,s,_,(t',s',_,(t'',s''),{x',y'})) {x,y} _ -> \c -> (\d -> ())

parenthesizedExpressions =
    (1 + (2 * 3) / 4) |> ((+) 0)


module Toolbox.Types (..) where

import Dict

type alias Ingredient =
  { name : String
  , value : Int
  , weight : Float
  , image : String
  , effects : List String
  }

type alias IngredientID =
  Int

type alias Response =
  { ingredients : List Ingredient
  }

type alias Model =
  { ingredients : Dict.Dict IngredientID Ingredient
  , selectedIds : List IngredientID
  }

initialModel : Model
initialModel =
  { ingredients = Dict.empty
  , selectedIds = []
  }

Use set instead of list for selected IDs.

module Toolbox.Types (..) where

import Dict
import Set

type alias Ingredient =
  { name : String
  , value : Int
  , weight : Float
  , image : String
  , effects : List String
  }

type alias IngredientID =
  Int

type alias Response =
  { ingredients : List Ingredient
  }

type alias Model =
  { ingredients : Dict.Dict IngredientID Ingredient
  , selectedIds : Set.Set IngredientID
  }

initialModel : Model
initialModel =
  { ingredients = Dict.empty
  , selectedIds = Set.empty
  }


module Component.Package.Search (view) where

import Graphics.Element (Element)
import Html (..)
import Html.Attributes (..)
import Html.Events (..)
import LocalChannel as LC
import Markdown

view : LC.LocalChannel String -> Int -> String -> Element
view fieldChan width fieldContent =
  toElement width 180 <|
  div []
    [ input
        [ placeholder "Package Search"
        , value fieldContent
        , on "input" targetValue (LC.send fieldChan)
        , inputStyle
        ]
        []
    , description
    ]

description : Html
description = Markdown.toHtml """

<span style="font-size: 12px; color: rgb(216, 221, 225);">
Search through all the functions and operators in this package.
Try searching for operators like `|>` or values like `map`.
</span>

"""

inputStyle =
  style
    [ ("display", "block")
    , ("margin", "10px 0 0 0")
    , ("padding", "10px")
    , ("border-style", "solid")
    , ("border-width", "1px")
    , ("border-color", "rgb(216, 221, 225)")
    , ("width", "178px")
    , ("appearance", "none")
    , ("box-shadow", "none")
    , ("border-radius", "4px")
    ]

Make the search box shorter

module Component.Package.Search (view) where

import Graphics.Element (Element)
import Html (..)
import Html.Attributes (..)
import Html.Events (..)
import LocalChannel as LC
import Markdown

view : LC.LocalChannel String -> Int -> String -> Element
view fieldChan width fieldContent =
  toElement width 150 <|
  div []
    [ input
        [ placeholder "Package Search"
        , value fieldContent
        , on "input" targetValue (LC.send fieldChan)
        , inputStyle
        ]
        []
    , description
    ]

description : Html
description = Markdown.toHtml """

<span style="font-size: 12px; color: rgb(216, 221, 225);">
Search through all the functions and operators in this package.
Try searching for `|>` or `map`.
</span>

"""

inputStyle =
  style
    [ ("display", "block")
    , ("margin", "10px 0 0 0")
    , ("padding", "10px")
    , ("border-style", "solid")
    , ("border-width", "1px")
    , ("border-color", "rgb(216, 221, 225)")
    , ("width", "178px")
    , ("appearance", "none")
    , ("box-shadow", "none")
    , ("border-radius", "4px")
    ]


module Toolbox.Views (..) where

import Html exposing (..)
import Html.Attributes exposing (..)
import Toolbox.Action exposing (Action)
import Toolbox.Types exposing (Ingredient, Model)

view : Signal.Address Action -> Model -> Html
view address model =
  case model.response of
    Just r ->
      div
        [ class "list-group" ]
        (List.map ingredientItem r.ingredients)

    Nothing ->
      div
        [ class "alert alert-info" ]
        [ text "Please wait..." ]

ingredientItem : Ingredient -> Html
ingredientItem i =
  a
    [ class "list-group-item", href "#" ]
    [ img [ src i.image, width 32, height 32 ] []
    , text i.name
    ]

Use Bootstrap 4 cards for ingredient list layout.

module Toolbox.Views (..) where

import Html exposing (..)
import Html.Attributes exposing (..)
import Toolbox.Action exposing (Action)
import Toolbox.Types exposing (Ingredient, Model)

view : Signal.Address Action -> Model -> Html
view address model =
  case model.response of
    Just r ->
      div
        [ class "container" ]
        [ div
            [ class "row" ]
            [ div
                [ class "col-sm-4" ]
                [ div
                    [ class "card" ]
                    [ div
                        [ class "card-block" ]
                        [ h4 [ class "card-title" ] [ text "Ingredients" ] ]
                    , div
                        [ class "list-group list-group-flush" ]
                        (List.map ingredientItem r.ingredients)
                    ]
                ]
            , div
                [ class "col-sm-8" ]
                [ h2 [] [ text "Recipe (TODO)" ] ]
            ]
        ]

    Nothing ->
      div
        [ class "alert alert-info" ]
        [ text "Please wait..." ]

ingredientItem : Ingredient -> Html
ingredientItem i =
  a
    [ class "list-group-item", href "#" ]
    [ img [ src i.image, width 32, height 32 ] []
    , text i.name
    ]


module Views.Menu.List exposing (view)

import Data.Retro exposing (Id)
import EveryDict exposing (EveryDict)
import Html exposing (Html)
import Html.Attributes as Attr
import Html.Events as Event
import Page.MenuModel exposing (Model, Retro)
import Page.MenuMsg exposing (..)

view : Maybe Id -> EveryDict Id Retro -> Html Msg
view current retros =
    Html.div [ Attr.class "menu" ]
        [ Html.ul [ Attr.class "menu-list" ]
            [ Html.li []
                [ Html.a [ Event.onClick NewRetro ]
                    [ Html.text "+ New Retro" ]
                ]
            ]
        , Html.p [ Attr.class "menu-label" ]
            [ Html.text "Your Retros" ]
        , Html.ul [ Attr.class "menu-list" ]
            (EveryDict.values retros
                |> List.map (choice current)
            )
        ]

choice : Maybe Id -> Retro -> Html Msg
choice current { id, name } =
    Html.li []
        [ Html.a
            [ Event.onClick (ShowRetroDetails id)
            , Attr.classList [ ( "is-active", Just id == current ) ]
            ]
            [ Html.text name ]
        ]

Sort list by date created

module Views.Menu.List exposing (view)

import Data.Retro exposing (Id)
import Date
import EveryDict exposing (EveryDict)
import Html exposing (Html)
import Html.Attributes as Attr
import Html.Events as Event
import Page.MenuModel exposing (Model, Retro)
import Page.MenuMsg exposing (..)

view : Maybe Id -> EveryDict Id Retro -> Html Msg
view current retros =
    Html.div [ Attr.class "menu" ]
        [ Html.ul [ Attr.class "menu-list" ]
            [ Html.li []
                [ Html.a [ Event.onClick NewRetro ]
                    [ Html.text "+ New Retro" ]
                ]
            ]
        , Html.p [ Attr.class "menu-label" ]
            [ Html.text "Your Retros" ]
        , Html.ul [ Attr.class "menu-list" ]
            (EveryDict.values retros
                |> List.sortBy (.createdAt >> Date.toTime >> negate)
                |> List.map (choice current)
            )
        ]

choice : Maybe Id -> Retro -> Html Msg
choice current { id, name } =
    Html.li []
        [ Html.a
            [ Event.onClick (ShowRetroDetails id)
            , Attr.classList [ ( "is-active", Just id == current ) ]
            ]
            [ Html.text name ]
        ]


-- a partially ordered forest
module IdeaFight.PartialForest exposing (Forest, empty, fromList, getNextPair, isEmpty)

type Forest a = Forest (List a)

fromList : List a -> Forest a
fromList values = Forest values

empty : Forest a
empty = fromList []

isEmpty : Forest a -> Bool
isEmpty (Forest values) =
  case values of
    [] -> True
    _  -> False

getNextPair : Forest a -> (a, a)
getNextPair (Forest values) =
  case values of
    a :: b :: _ -> (a, b)
    _ -> Debug.crash "oh shit"

Rearrange forest to think in nodes

-- a partially ordered forest
module IdeaFight.PartialForest exposing (Forest, empty, fromList, getNextPair, isEmpty)

type Node a = Node a (List (Node a))
type Forest a = Forest (List (Node a))

makeNode : a -> Node a
makeNode value = Node value []

fromList : List a -> Forest a
fromList values = Forest <| List.map makeNode values

empty : Forest a
empty = fromList []

isEmpty : Forest a -> Bool
isEmpty (Forest values) =
  case values of
    [] -> True
    _  -> False

getNextPair : Forest a -> (a, a)
getNextPair (Forest values) =
  case values of
    (Node a _) :: (Node b _) :: _ -> (a, b)
    _ -> Debug.crash "oh shit"


module Caldwell.Header.Styles exposing (css)

-- Libraries

import Css exposing (..)
import Css.Elements
    exposing
        ( header
        , span
        )

-- Source

import Caldwell.Helpers exposing (prop)
import Caldwell.Constants
    exposing
        ( black
        , gutterSize
        , titleHeight
        )

css : List Snippet
css =
    [ header
        [ prop "user-select" "none"
        , fontFamily cursive
        , fontFamilies [ "Megrim" ]
        , fontSize titleHeight
        , cursor pointer
        , position fixed
        , right zero
          -- plus padding ends up being 68px
          -- , width (pct 100)
        , padding4 gutterSize gutterSize zero zero
        , borderBottomLeftRadius (px 10)
        , backgroundColor (rgba 0 0 0 0.93)
        , prop "box-shadow" "0px 0px 7px black, 0px 0px 37px black, 0px 0px 57px black, 0px 0px 77px black"
        , prop "text-shadow" "0px 0px 7px white"
        , prop "z-index" "1"
        , lineHeight (num 1.4)
        , children
            [ span
                [ fontFamilies [ "Monoton" ]
                , float left
                ]
            ]
        ]
    ]

Update Header style a bit...

module Caldwell.Header.Styles exposing (css)

-- Libraries

import Css exposing (..)
import Css.Elements
    exposing
        ( header
        , span
        )

-- Source

import Caldwell.Helpers exposing (prop)
import Caldwell.Constants
    exposing
        ( black
        , gutterSize
        , titleHeight
        )

css : List Snippet
css =
    [ header
        [ prop "user-select" "none"
        , fontFamily cursive
        , fontFamilies [ "Megrim" ]
        , fontSize titleHeight
        , cursor pointer
        , position fixed
        , right zero
          -- plus padding ends up being 68px
          -- , width (pct 100)
        , padding4 gutterSize gutterSize zero (Css.rem 0.5)
        , borderBottomLeftRadius (px 30)
        , backgroundColor (rgba 0 0 0 0.93)
        , prop "box-shadow" "0px 0px 7px black, 0px 0px 37px black, 0px 0px 57px black, 0px 0px 77px black"
        , prop "text-shadow" "0px 0px 7px white"
        , prop "z-index" "1"
        , lineHeight (num 1.4)
        , children
            [ span
                [ fontFamilies [ "Monoton" ]
                , float left
                ]
            ]
        ]
    ]