Provide an algorithm for buttons pagination

module Main where

import Prelude (map, (<=), ($), show, (>), (&&), (<>), (-), (>=), otherwise, (+))
import Data.Array ((..))

paginate :: Int -> Int -> Array String
paginate page activep
    | page <= 10 = map show $ 1..page
    | page > 10 && activep <= 5 = (map show $ 1..7) <> [".."] <> (map show [page-1, page])
    | activep >= page -5 = (map show $ 1..2) <> [".."] <> (map show $ (page-6)..page)
    | otherwise = (map show $ 1..2) <> [".."] <> (map show $ (activep-1)..(activep+2)) <> [".."] <> (map show [page-1, page])

error: pathspec 'app/core/puresc-helper/paginate.purs' did not match any file(s) known to git


NoSuchInvitation error

NoSuchInvitation error

-- File auto generated by purescript-bridge! --
module Gonimo.Server.Error where

import Gonimo.Server.DbEntities (Family)
import Gonimo.Types (Key)

import Data.Generic (class Generic)

data ServerError =
    InvalidAuthToken
  | InvitationAlreadyClaimed
  | AlreadyFamilyMember
  | NoSuchFamily (Key Family)
  | NoSuchInvitation
  | Forbidden
  | NotFound
  | TransactionTimeout

derive instance genericServerError :: Generic ServerError

-- File auto generated by purescript-bridge! --
module Gonimo.Server.Error where

import Gonimo.Server.DbEntities (Family)
import Gonimo.Types (Key)

import Data.Generic (class Generic)

data ServerError =
    InvalidAuthToken
  | InvitationAlreadyClaimed
  | AlreadyFamilyMember
  | NoSuchFamily (Key Family)
  | Forbidden
  | NotFound
  | TransactionTimeout

derive instance genericServerError :: Generic ServerError


Added international spelling of SI units

-- | This module defines the parser for the Insect language.
module Insect.Parser
  ( DictEntry(..)
  , (==>)
  , Dictionary(..)
  , commands
  , functions
  , siPrefixDict
  , normalUnitDict
  , imperialUnitDict
  , parseInsect
  ) where

import Prelude hiding (degree)

import Control.Alt ((<|>))
import Control.Lazy (fix)

import Quantities (DerivedUnit, (./))
import Quantities as Q

import Data.Array (some, fromFoldable)
import Data.Either (Either(..))
import Data.Decimal (Decimal, fromString, fromNumber, isFinite)
import Data.Foldable (foldr, foldMap)
import Data.Foldable as F
import Data.List (List, many, init, last)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.NonEmpty (NonEmpty, (:|), foldl1)
import Data.String (fromCharArray, singleton)
import Data.Tuple (Tuple(..))

import Text.Parsing.Parser (ParserT, Parser, ParseError, runParser, fail)
import Text.Parsing.Parser.Combinators (option, optionMaybe, try, (<?>),
                                        notFollowedBy)
import Text.Parsing.Parser.String (string, char, eof, oneOf)
import Text.Parsing.Parser.Token (GenLanguageDef(..), LanguageDef, TokenParser,
                                  digit, letter, makeTokenParser)

import Insect.Language (Func(..), BinOp(..), Expression(..), Command(..),
                        Statement(..))

-- | A type synonym for the main Parser type with `String` as input.
type P a = Parser String a

-- | Possible characters for the first character of an identifier.
identStart ∷ P Char
identStart = letter <|> char '_'

-- | Possible characters for identifiers (not for the first character).
identLetter ∷ P Char
identLetter = letter <|> digit <|> char '_' <|> char '\''

-- | A list of allowed commands
commands ∷ Array String
commands = ["help", "?", "list", "ls", "ll", "reset", "clear", "cls", "quit", "exit"]

-- | The language definition.
insectLanguage ∷ LanguageDef
insectLanguage = LanguageDef
  { commentStart: ""
  , commentEnd: ""
  , commentLine: "#"
  , nestedComments: false
  , identStart: identStart
  , identLetter: identLetter
  , opStart: oneOf ['+', '-', '*', '·', '⋅', '×', '/', '÷', '^', '!', '→', '=']
  , opLetter: oneOf []
  , reservedNames: commands <> ["²", "³", "to", "per"]
  , reservedOpNames: ["->", "+", "-", "*", "·", "⋅", "×", "/", "÷", "^", "!",
                      "**", "="]
  , caseSensitive: true
}

-- | The actual token parser.
token ∷ TokenParser
token = makeTokenParser insectLanguage

-- | Parse something, inside of parens.
parens ∷ ∀ a. P a → P a
parens = token.parens

-- | Parse one of the reserved operators.
reservedOp ∷ String → P Unit
reservedOp = token.reservedOp

-- | Parse a reserverd keyword.
reserved ∷ String → P Unit
reserved = token.reserved

-- | Parse zero or more whitespace characters.
whiteSpace ∷ P Unit
whiteSpace = token.whiteSpace

-- | Parse a number.
number ∷ P Decimal
number = do
  intPart ← digits

  mFracPart ← optionMaybe (append <$> string "." <*> digits)
  let fracPart = fromMaybe "" mFracPart

  mExpPart ← optionMaybe $ try do
    _ ← string "e"
    notFollowedBy identStart
    sad ← signAndDigits
    pure ("e" <> sad)
  let expPart = fromMaybe "" mExpPart

  whiteSpace

  let floatStr = intPart <> fracPart <> expPart

  case fromString floatStr of
    Just num →
      if isFinite num
      then pure num
      else fail "This number is too large"
    Nothing → fail $ "Parsing of number failed for input '" <> floatStr <> "'"

  where
    digits ∷ P String
    digits = do
      ds ← some $ oneOf ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] <?> "a digit"
      pure $ fromCharArray (fromFoldable ds)

    signAndDigits ∷ P String
    signAndDigits = do
      sign ← option '+' (oneOf ['+', '-'])
      intPart ← digits
      pure $ singleton sign <> intPart

-- | A helper type for entries in the dictionary.
data DictEntry a = DictEntry a (Array String)

infix 4 DictEntry as ==>

-- | A dictionary of units and their abbreviations.
data Dictionary a = Dictionary (Array (DictEntry a))

-- | Build a parser from a Dictionary
buildDictParser ∷ ∀ a. Dictionary a → P a
buildDictParser (Dictionary dict) = F.oneOf $ entryParser <$> dict
  where
    entryParser (x ==> abbrevs) = F.oneOf $ abbrevParser x <$> abbrevs
    abbrevParser x abbrev = string abbrev *> pure x

siPrefixDict ∷ Dictionary (DerivedUnit → DerivedUnit)
siPrefixDict = Dictionary
  [ Q.atto ==> ["atto", "a"]
  , Q.femto ==> ["femto", "f"]
  -- peta and mega have to be up here (before pico and milli) in order for the
  -- prefixes ('p' and 'm') not to be parsed as 'pico' or 'milli'.
  , Q.peta ==> ["peta"]
  , Q.mega ==> ["mega"]
  , Q.pico ==> ["pico", "p"]
  , Q.nano ==> ["nano", "n"]
  , Q.micro ==> [ "micro"
                , "µ" -- Micro sign U+00B5
                , "μ" -- Greek small letter mu U+039C
                ]
  , Q.milli ==> ["milli", "m"]
  , Q.centi ==> ["centi", "c"]
  , Q.deci ==> ["deci", "d"]
  , Q.hecto ==> ["hecto", "h"]
  , Q.kilo ==> ["kilo", "k"]
  , Q.mega ==> ["M"]
  , Q.giga ==> ["giga", "G"]
  , Q.tera ==> ["tera", "T"]
  , Q.peta ==> ["P"]
  , Q.exa ==> ["exa", "E"]
  ]

-- | Parse a SI prefix like `µ` or `G`.
siPrefix ∷ P (DerivedUnit → DerivedUnit)
siPrefix = buildDictParser siPrefixDict <|> pure id

-- | Normal (SI-conform, non-imperial) units
normalUnitDict ∷ Dictionary DerivedUnit
normalUnitDict = Dictionary
  [ Q.radian ==> ["radians", "radian", "rad"]
  , Q.degree ==> ["degrees", "degree", "deg", "°"]
  , Q.hertz ==> ["hertz", "Hz"]
  , Q.newton ==> ["newton", "N"]
  , Q.joule ==> ["joules", "joule", "J"]
  , Q.pascal ==> ["pascal", "Pa"]
  , Q.volt ==> ["volts", "volt", "V"]
  , Q.farad ==> ["farad", "F"]
  , Q.ohm ==> ["ohms", "ohm", "Ω"]
  , Q.sievert ==> ["sievert", "Sv"]
  , Q.weber ==> ["weber", "Wb"]
  , Q.tesla ==> ["tesla", "T"]
  , Q.henry ==> ["henry", "H"]
  , Q.coulomb ==> ["coulomb", "C"]
  , Q.siemens ==> ["siemens", "S"]
  , Q.lumen ==> ["lumen", "lm"]
  , Q.lux ==> ["lux", "lx"]
  , Q.becquerel ==> ["becquerel", "Bq"]
  , Q.gray ==> ["gray", "Gy"]
  , Q.katal ==> ["katal", "kat"]
  , Q.hectare ==> ["hectare", "ha"]
  , Q.liter ==> ["liters", "liter", "litres", "litre", "L"]
  , Q.tonne ==> ["tonnes", "tonne", "tons", "ton"]
  , Q.electronvolt ==> ["electronvolt", "eV"]
  , Q.bel ==> ["bel"]
  , Q.astronomicalUnit ==> ["AU"]
  , Q.barn ==> ["barn"]
  , Q.bar ==> ["bar"]
  , Q.angstrom ==> ["angstrom", "Å"]
  , Q.gauss ==> ["gauss"]
  , Q.ampere ==> ["amperes", "ampere", "A"]
  , Q.mole ==> ["mole", "mol"]
  , Q.kelvin ==> ["kelvin", "K"]
  , Q.candela ==> ["candela", "cd"]
  , Q.watt <> Q.hour ==> ["Wh"]
  , Q.watt ==> ["watts", "watt", "W"]
  , Q.byte ==> ["Bytes", "bytes", "Byte", "byte", "B"]
  , Q.bit ==> ["bits", "bit"]
  , Q.bit ./ Q.second ==> ["bps"]
  , Q.second ==> ["seconds", "second", "sec", "s"]
  , Q.minute ==> ["minutes", "minute", "min"]
  , Q.hour ==> ["hours", "hour", "h"]
  , Q.day ==> ["days", "day"]
  , Q.week ==> ["weeks", "week"]
  , Q.month ==> ["months", "month"]
  , Q.year ==> ["years", "year"]
  , Q.gram ==> ["grammes", "gramme", "grams", "gram", "g"]
  , Q.meter ==> ["metres", "metre", "meters", "meter", "m"]
  ]

-- | Parse a normal (SI-conform, non-imperical) unit, like `N` or `watt`.
normalUnit ∷ P DerivedUnit
normalUnit = buildDictParser normalUnitDict <?> "normal unit"

-- | Imperial units
imperialUnitDict ∷ Dictionary DerivedUnit
imperialUnitDict = Dictionary
  [ Q.mile ==> ["miles", "mile"]
  , Q.mile ./ Q.hour ==> ["mph"]
  , Q.inch ==> ["inches", "inch", "in"]
  , Q.yard ==> ["yards", "yard", "yd"]
  , Q.foot ==> ["feet", "foot", "ft"]
  , Q.ounce ==> ["ounces", "ounce", "oz"]
  , Q.pound ==> ["pounds", "pound", "lb"]
  , Q.gallon ==> ["gallons", "gallon", "gal"]
  , Q.pint ==> ["pints", "pint"]
  , Q.cup ==> ["cups", "cup"]
  , Q.tablespoon ==> ["tablespoons", "tablespoon", "tbsp"]
  , Q.teaspoon ==> ["teaspoons", "teaspoon", "tsp"]
  ]

-- | Parse an imperial unit like `ft` of `mile`.
imperialUnit ∷ P DerivedUnit
imperialUnit = buildDictParser imperialUnitDict <?> "imperial unit"

-- | Parse a 'normal' unit with SI prefix, like `km` or `Gb`.
unitWithSIPrefix ∷ P DerivedUnit
unitWithSIPrefix = do
  p ← siPrefix
  u ← normalUnit
  pure $ p u

specialCases ∷ P DerivedUnit
specialCases =
  -- The abbreviation 'd' for 'day' needs to be treated separately. Otherwise,
  -- 'cd' will be parsed as 'centi day' instead of 'candela'.
      string "d" *> pure Q.day
  -- Similarly, the abbreviation 't' for 'tonne' needs special treatment.
  -- Otherwise, 'ft' will be parsed as 'femto tonne' instead of 'feet'.
  <|> string "t" *> pure Q.tonne

-- | Parse a derived unit, like `km`, `ft`, or `s`.
derivedUnit ∷ P DerivedUnit
derivedUnit =
  (
        try (augment unitWithSIPrefix)
    <|> augment imperialUnit
    <|> augment normalUnit
    <|> augment specialCases
  ) <* whiteSpace
  where
    augment p = p <* notFollowedBy identLetter

-- | Parse the name of a variable, like `my_variable'`.
variable ∷ P Expression
variable = Variable <$> token.identifier

-- | Possible names for the mathematical functions.
funcNameDict ∷ Dictionary Func
funcNameDict = Dictionary
  [ Acosh ==> ["acosh"]
  , Acos ==> ["acos"]
  , Asinh ==> ["asinh"]
  , Asin ==> ["asin"]
  , Atanh ==> ["atanh"]
  , Atan ==> ["atan"]
  , Ceil ==> ["ceil"]
  , Cosh ==> ["cosh"]
  , Cos ==> ["cos"]
  , Exp ==> ["exp"]
  , Floor ==> ["floor"]
  , Gamma ==> ["gamma"]
  , Log10 ==> ["log10"]
  , Ln ==> ["log", "ln"]
  , Round ==> ["round"]
  , Sinh ==> ["sinh"]
  , Sin ==> ["sin"]
  , Sqrt ==> ["sqrt"]
  , Tanh ==> ["tanh"]
  , Tan ==> ["tan"]
  ]

-- | A list of all mathematical function names (for tab-completion).
functions ∷ Array String
functions =
  case funcNameDict of
    Dictionary dict → foldMap (\(_ ==> names) → names) dict

-- | Parse the name of a mathematical function.
funcName ∷ P Func
funcName = buildDictParser funcNameDict <?> "function name"

-- | A version of `sepBy1` that returns a `NonEmpty List`.
sepBy1 ∷ ∀ m s a sep. Monad m ⇒ ParserT s m a → ParserT s m sep → ParserT s m (NonEmpty List a)
sepBy1 p sep = do
  a ← p
  as ← many $ sep *> p
  pure (a :| as)

-- | Fold a non-empty structure, collecting results using a binary operation.
foldr1 ∷ ∀ a. (a → a → a) → NonEmpty List a → a
foldr1 f (a :| xs) =
  case init xs, last xs of
    Just bs, Just b → f a (foldr f b bs)
    _, _ → a

-- | Parse a full mathematical expression.
expression ∷ P Expression
expression =
  fix \p →
    let
      atomic ∷ P Expression
      atomic = whiteSpace *> (
              parens p
          <|> (Scalar <$> number)
          <|> try (Unit <$> derivedUnit)
          <|> try (Apply <$> funcName <*> (parens p <* whiteSpace))
          <|> variable
          )

      suffixFac ∷ P Expression
      suffixFac = do
        a ← atomic
        mf ← optionMaybe (facOp *> pure Factorial)
        case mf of
          Just f → pure $ f a
          Nothing → pure a

      suffixPow ∷ P Expression
      suffixPow = do
        x ← suffixFac
        mFn ← optionMaybe ((sqrOp *> pure square) <|> (cubOp *> pure cube))
        case mFn of
          Just fn → pure $ fn x
          Nothing → pure x

      sepByPow ∷ P Expression
      sepByPow = foldr1 (BinOp Pow) <$> suffixPow `sepBy1` powOp

      sepByMulImplicit ∷ P Expression
      sepByMulImplicit = foldl1 (BinOp Mul) <$> sepByPow `sepBy1` pure unit

      sepByDiv ∷ P Expression
      sepByDiv = foldl1 (BinOp Div) <$> sepByMulImplicit `sepBy1` divOp

      sepByMul ∷ P Expression
      sepByMul = foldl1 (BinOp Mul) <$> sepByDiv `sepBy1` mulOp

      prefixed ∷ P Expression
      prefixed = do
        prefixFn ← ((subOp *> pure Negate) <|> (addOp *> pure id) <|> pure id)
        prefixFn <$> sepByMul

      sepBySub ∷ P Expression
      sepBySub = foldl1 (BinOp Sub) <$> prefixed `sepBy1` subOp

      sepByAdd ∷ P Expression
      sepByAdd = foldl1 (BinOp Add) <$> sepBySub `sepBy1` addOp

      sepByConv ∷ P Expression
      sepByConv = foldl1 (BinOp ConvertTo) <$> sepByAdd `sepBy1` arrOp

    in sepByConv

  where

    facOp = reservedOp "!"
    powOp = reservedOp "^" <|> reservedOp "**"
    sqrOp = reservedOp "²"
    cubOp = reservedOp "³"
    divOp = reservedOp "/" <|> reservedOp "÷" <|> reserved "per"
    mulOp = reservedOp "*" <|> reservedOp "·" <|> reservedOp "⋅"
                           <|> reservedOp "×"
    subOp = reservedOp "-"
    addOp = reservedOp "+"
    arrOp = reservedOp "->" <|> reservedOp "→" <|> reserved "to"

    square q = BinOp Pow q (Scalar $ fromNumber 2.0)
    cube q = BinOp Pow q (Scalar $ fromNumber 3.0)

-- | Parse a mathematical expression (or conversion) like `3m+2in -> cm`.
fullExpression ∷ P Expression
fullExpression = do
  whiteSpace
  expr ← expression
  eof <?> "end of input"

  pure $ expr

-- | Parse an Insect command.
command ∷ P Command
command =
  (
        (reserved "help" <|> reserved "?") *> pure Help
    <|> (reserved "list" <|> reserved "ls" <|> reserved "ll") *> pure List
    <|> (reserved "reset") *> pure Reset
    <|> (reserved "clear" <|> reserved "cls") *> pure Clear
    <|> (reserved "quit" <|> reserved "exit") *> pure Quit
  ) <* eof

-- | Parse a variable assignment like `x = 3m*pi`
assignment ∷ P (Tuple String Expression)
assignment = do
  whiteSpace
  var ← token.identifier
  reservedOp "="
  value ← expression
  eof
  pure $ Tuple var value

-- | Try to parse the identifier as a unit, and fail if it succeeds.
checkIdentifier ∷ Tuple String Expression → P Statement
checkIdentifier (Tuple var value) =
  case runParser var (derivedUnit <* eof) of
    Right _ →
      fail $ "'" <> var <> "' is reserved for a physical unit"
    Left _ →
      case runParser var (funcName <* eof) of
        Right _ →
          fail $ "'" <> var <> "' is reserved for a math. function"
        Left _ →
          pure $ Assignment var value

-- | Parse a statement in the Insect language.
statement ∷ P Statement
statement =
      (Command <$> command)
  <|> (try assignment >>= checkIdentifier)
  <|> (Expression <$> fullExpression)

-- | Run the Insect-parser on a `String` input.
parseInsect ∷ String → Either ParseError Statement
parseInsect inp = runParser inp statement

-- | This module defines the parser for the Insect language.
module Insect.Parser
  ( DictEntry(..)
  , (==>)
  , Dictionary(..)
  , commands
  , functions
  , siPrefixDict
  , normalUnitDict
  , imperialUnitDict
  , parseInsect
  ) where

import Prelude hiding (degree)

import Control.Alt ((<|>))
import Control.Lazy (fix)

import Quantities (DerivedUnit, (./))
import Quantities as Q

import Data.Array (some, fromFoldable)
import Data.Either (Either(..))
import Data.Decimal (Decimal, fromString, fromNumber, isFinite)
import Data.Foldable (foldr, foldMap)
import Data.Foldable as F
import Data.List (List, many, init, last)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.NonEmpty (NonEmpty, (:|), foldl1)
import Data.String (fromCharArray, singleton)
import Data.Tuple (Tuple(..))

import Text.Parsing.Parser (ParserT, Parser, ParseError, runParser, fail)
import Text.Parsing.Parser.Combinators (option, optionMaybe, try, (<?>),
                                        notFollowedBy)
import Text.Parsing.Parser.String (string, char, eof, oneOf)
import Text.Parsing.Parser.Token (GenLanguageDef(..), LanguageDef, TokenParser,
                                  digit, letter, makeTokenParser)

import Insect.Language (Func(..), BinOp(..), Expression(..), Command(..),
                        Statement(..))

-- | A type synonym for the main Parser type with `String` as input.
type P a = Parser String a

-- | Possible characters for the first character of an identifier.
identStart ∷ P Char
identStart = letter <|> char '_'

-- | Possible characters for identifiers (not for the first character).
identLetter ∷ P Char
identLetter = letter <|> digit <|> char '_' <|> char '\''

-- | A list of allowed commands
commands ∷ Array String
commands = ["help", "?", "list", "ls", "ll", "reset", "clear", "cls", "quit", "exit"]

-- | The language definition.
insectLanguage ∷ LanguageDef
insectLanguage = LanguageDef
  { commentStart: ""
  , commentEnd: ""
  , commentLine: "#"
  , nestedComments: false
  , identStart: identStart
  , identLetter: identLetter
  , opStart: oneOf ['+', '-', '*', '·', '⋅', '×', '/', '÷', '^', '!', '→', '=']
  , opLetter: oneOf []
  , reservedNames: commands <> ["²", "³", "to", "per"]
  , reservedOpNames: ["->", "+", "-", "*", "·", "⋅", "×", "/", "÷", "^", "!",
                      "**", "="]
  , caseSensitive: true
}

-- | The actual token parser.
token ∷ TokenParser
token = makeTokenParser insectLanguage

-- | Parse something, inside of parens.
parens ∷ ∀ a. P a → P a
parens = token.parens

-- | Parse one of the reserved operators.
reservedOp ∷ String → P Unit
reservedOp = token.reservedOp

-- | Parse a reserverd keyword.
reserved ∷ String → P Unit
reserved = token.reserved

-- | Parse zero or more whitespace characters.
whiteSpace ∷ P Unit
whiteSpace = token.whiteSpace

-- | Parse a number.
number ∷ P Decimal
number = do
  intPart ← digits

  mFracPart ← optionMaybe (append <$> string "." <*> digits)
  let fracPart = fromMaybe "" mFracPart

  mExpPart ← optionMaybe $ try do
    _ ← string "e"
    notFollowedBy identStart
    sad ← signAndDigits
    pure ("e" <> sad)
  let expPart = fromMaybe "" mExpPart

  whiteSpace

  let floatStr = intPart <> fracPart <> expPart

  case fromString floatStr of
    Just num →
      if isFinite num
      then pure num
      else fail "This number is too large"
    Nothing → fail $ "Parsing of number failed for input '" <> floatStr <> "'"

  where
    digits ∷ P String
    digits = do
      ds ← some $ oneOf ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'] <?> "a digit"
      pure $ fromCharArray (fromFoldable ds)

    signAndDigits ∷ P String
    signAndDigits = do
      sign ← option '+' (oneOf ['+', '-'])
      intPart ← digits
      pure $ singleton sign <> intPart

-- | A helper type for entries in the dictionary.
data DictEntry a = DictEntry a (Array String)

infix 4 DictEntry as ==>

-- | A dictionary of units and their abbreviations.
data Dictionary a = Dictionary (Array (DictEntry a))

-- | Build a parser from a Dictionary
buildDictParser ∷ ∀ a. Dictionary a → P a
buildDictParser (Dictionary dict) = F.oneOf $ entryParser <$> dict
  where
    entryParser (x ==> abbrevs) = F.oneOf $ abbrevParser x <$> abbrevs
    abbrevParser x abbrev = string abbrev *> pure x

siPrefixDict ∷ Dictionary (DerivedUnit → DerivedUnit)
siPrefixDict = Dictionary
  [ Q.atto ==> ["atto", "a"]
  , Q.femto ==> ["femto", "f"]
  -- peta and mega have to be up here (before pico and milli) in order for the
  -- prefixes ('p' and 'm') not to be parsed as 'pico' or 'milli'.
  , Q.peta ==> ["peta"]
  , Q.mega ==> ["mega"]
  , Q.pico ==> ["pico", "p"]
  , Q.nano ==> ["nano", "n"]
  , Q.micro ==> [ "micro"
                , "µ" -- Micro sign U+00B5
                , "μ" -- Greek small letter mu U+039C
                ]
  , Q.milli ==> ["milli", "m"]
  , Q.centi ==> ["centi", "c"]
  , Q.deci ==> ["deci", "d"]
  , Q.hecto ==> ["hecto", "h"]
  , Q.kilo ==> ["kilo", "k"]
  , Q.mega ==> ["M"]
  , Q.giga ==> ["giga", "G"]
  , Q.tera ==> ["tera", "T"]
  , Q.peta ==> ["P"]
  , Q.exa ==> ["exa", "E"]
  ]

-- | Parse a SI prefix like `µ` or `G`.
siPrefix ∷ P (DerivedUnit → DerivedUnit)
siPrefix = buildDictParser siPrefixDict <|> pure id

-- | Normal (SI-conform, non-imperial) units
normalUnitDict ∷ Dictionary DerivedUnit
normalUnitDict = Dictionary
  [ Q.radian ==> ["radians", "radian", "rad"]
  , Q.degree ==> ["degrees", "degree", "deg", "°"]
  , Q.hertz ==> ["hertz", "Hz"]
  , Q.newton ==> ["newton", "N"]
  , Q.joule ==> ["joules", "joule", "J"]
  , Q.pascal ==> ["pascal", "Pa"]
  , Q.volt ==> ["volts", "volt", "V"]
  , Q.farad ==> ["farad", "F"]
  , Q.ohm ==> ["ohms", "ohm", "Ω"]
  , Q.sievert ==> ["sievert", "Sv"]
  , Q.weber ==> ["weber", "Wb"]
  , Q.tesla ==> ["tesla", "T"]
  , Q.henry ==> ["henry", "H"]
  , Q.coulomb ==> ["coulomb", "C"]
  , Q.siemens ==> ["siemens", "S"]
  , Q.lumen ==> ["lumen", "lm"]
  , Q.lux ==> ["lux", "lx"]
  , Q.becquerel ==> ["becquerel", "Bq"]
  , Q.gray ==> ["gray", "Gy"]
  , Q.katal ==> ["katal", "kat"]
  , Q.hectare ==> ["hectare", "ha"]
  , Q.liter ==> ["liters", "liter", "L"]
  , Q.tonne ==> ["tonnes", "tonne", "tons", "ton"]
  , Q.electronvolt ==> ["electronvolt", "eV"]
  , Q.bel ==> ["bel"]
  , Q.astronomicalUnit ==> ["AU"]
  , Q.barn ==> ["barn"]
  , Q.bar ==> ["bar"]
  , Q.angstrom ==> ["angstrom", "Å"]
  , Q.gauss ==> ["gauss"]
  , Q.ampere ==> ["amperes", "ampere", "A"]
  , Q.mole ==> ["mole", "mol"]
  , Q.kelvin ==> ["kelvin", "K"]
  , Q.candela ==> ["candela", "cd"]
  , Q.watt <> Q.hour ==> ["Wh"]
  , Q.watt ==> ["watts", "watt", "W"]
  , Q.byte ==> ["Bytes", "bytes", "Byte", "byte", "B"]
  , Q.bit ==> ["bits", "bit"]
  , Q.bit ./ Q.second ==> ["bps"]
  , Q.second ==> ["seconds", "second", "sec", "s"]
  , Q.minute ==> ["minutes", "minute", "min"]
  , Q.hour ==> ["hours", "hour", "h"]
  , Q.day ==> ["days", "day"]
  , Q.week ==> ["weeks", "week"]
  , Q.month ==> ["months", "month"]
  , Q.year ==> ["years", "year"]
  , Q.gram ==> ["grams", "gram", "g"]
  , Q.meter ==> ["meters", "meter", "m"]
  ]

-- | Parse a normal (SI-conform, non-imperical) unit, like `N` or `watt`.
normalUnit ∷ P DerivedUnit
normalUnit = buildDictParser normalUnitDict <?> "normal unit"

-- | Imperial units
imperialUnitDict ∷ Dictionary DerivedUnit
imperialUnitDict = Dictionary
  [ Q.mile ==> ["miles", "mile"]
  , Q.mile ./ Q.hour ==> ["mph"]
  , Q.inch ==> ["inches", "inch", "in"]
  , Q.yard ==> ["yards", "yard", "yd"]
  , Q.foot ==> ["feet", "foot", "ft"]
  , Q.ounce ==> ["ounces", "ounce", "oz"]
  , Q.pound ==> ["pounds", "pound", "lb"]
  , Q.gallon ==> ["gallons", "gallon", "gal"]
  , Q.pint ==> ["pints", "pint"]
  , Q.cup ==> ["cups", "cup"]
  , Q.tablespoon ==> ["tablespoons", "tablespoon", "tbsp"]
  , Q.teaspoon ==> ["teaspoons", "teaspoon", "tsp"]
  ]

-- | Parse an imperial unit like `ft` of `mile`.
imperialUnit ∷ P DerivedUnit
imperialUnit = buildDictParser imperialUnitDict <?> "imperial unit"

-- | Parse a 'normal' unit with SI prefix, like `km` or `Gb`.
unitWithSIPrefix ∷ P DerivedUnit
unitWithSIPrefix = do
  p ← siPrefix
  u ← normalUnit
  pure $ p u

specialCases ∷ P DerivedUnit
specialCases =
  -- The abbreviation 'd' for 'day' needs to be treated separately. Otherwise,
  -- 'cd' will be parsed as 'centi day' instead of 'candela'.
      string "d" *> pure Q.day
  -- Similarly, the abbreviation 't' for 'tonne' needs special treatment.
  -- Otherwise, 'ft' will be parsed as 'femto tonne' instead of 'feet'.
  <|> string "t" *> pure Q.tonne

-- | Parse a derived unit, like `km`, `ft`, or `s`.
derivedUnit ∷ P DerivedUnit
derivedUnit =
  (
        try (augment unitWithSIPrefix)
    <|> augment imperialUnit
    <|> augment normalUnit
    <|> augment specialCases
  ) <* whiteSpace
  where
    augment p = p <* notFollowedBy identLetter

-- | Parse the name of a variable, like `my_variable'`.
variable ∷ P Expression
variable = Variable <$> token.identifier

-- | Possible names for the mathematical functions.
funcNameDict ∷ Dictionary Func
funcNameDict = Dictionary
  [ Acosh ==> ["acosh"]
  , Acos ==> ["acos"]
  , Asinh ==> ["asinh"]
  , Asin ==> ["asin"]
  , Atanh ==> ["atanh"]
  , Atan ==> ["atan"]
  , Ceil ==> ["ceil"]
  , Cosh ==> ["cosh"]
  , Cos ==> ["cos"]
  , Exp ==> ["exp"]
  , Floor ==> ["floor"]
  , Gamma ==> ["gamma"]
  , Log10 ==> ["log10"]
  , Ln ==> ["log", "ln"]
  , Round ==> ["round"]
  , Sinh ==> ["sinh"]
  , Sin ==> ["sin"]
  , Sqrt ==> ["sqrt"]
  , Tanh ==> ["tanh"]
  , Tan ==> ["tan"]
  ]

-- | A list of all mathematical function names (for tab-completion).
functions ∷ Array String
functions =
  case funcNameDict of
    Dictionary dict → foldMap (\(_ ==> names) → names) dict

-- | Parse the name of a mathematical function.
funcName ∷ P Func
funcName = buildDictParser funcNameDict <?> "function name"

-- | A version of `sepBy1` that returns a `NonEmpty List`.
sepBy1 ∷ ∀ m s a sep. Monad m ⇒ ParserT s m a → ParserT s m sep → ParserT s m (NonEmpty List a)
sepBy1 p sep = do
  a ← p
  as ← many $ sep *> p
  pure (a :| as)

-- | Fold a non-empty structure, collecting results using a binary operation.
foldr1 ∷ ∀ a. (a → a → a) → NonEmpty List a → a
foldr1 f (a :| xs) =
  case init xs, last xs of
    Just bs, Just b → f a (foldr f b bs)
    _, _ → a

-- | Parse a full mathematical expression.
expression ∷ P Expression
expression =
  fix \p →
    let
      atomic ∷ P Expression
      atomic = whiteSpace *> (
              parens p
          <|> (Scalar <$> number)
          <|> try (Unit <$> derivedUnit)
          <|> try (Apply <$> funcName <*> (parens p <* whiteSpace))
          <|> variable
          )

      suffixFac ∷ P Expression
      suffixFac = do
        a ← atomic
        mf ← optionMaybe (facOp *> pure Factorial)
        case mf of
          Just f → pure $ f a
          Nothing → pure a

      suffixPow ∷ P Expression
      suffixPow = do
        x ← suffixFac
        mFn ← optionMaybe ((sqrOp *> pure square) <|> (cubOp *> pure cube))
        case mFn of
          Just fn → pure $ fn x
          Nothing → pure x

      sepByPow ∷ P Expression
      sepByPow = foldr1 (BinOp Pow) <$> suffixPow `sepBy1` powOp

      sepByMulImplicit ∷ P Expression
      sepByMulImplicit = foldl1 (BinOp Mul) <$> sepByPow `sepBy1` pure unit

      sepByDiv ∷ P Expression
      sepByDiv = foldl1 (BinOp Div) <$> sepByMulImplicit `sepBy1` divOp

      sepByMul ∷ P Expression
      sepByMul = foldl1 (BinOp Mul) <$> sepByDiv `sepBy1` mulOp

      prefixed ∷ P Expression
      prefixed = do
        prefixFn ← ((subOp *> pure Negate) <|> (addOp *> pure id) <|> pure id)
        prefixFn <$> sepByMul

      sepBySub ∷ P Expression
      sepBySub = foldl1 (BinOp Sub) <$> prefixed `sepBy1` subOp

      sepByAdd ∷ P Expression
      sepByAdd = foldl1 (BinOp Add) <$> sepBySub `sepBy1` addOp

      sepByConv ∷ P Expression
      sepByConv = foldl1 (BinOp ConvertTo) <$> sepByAdd `sepBy1` arrOp

    in sepByConv

  where

    facOp = reservedOp "!"
    powOp = reservedOp "^" <|> reservedOp "**"
    sqrOp = reservedOp "²"
    cubOp = reservedOp "³"
    divOp = reservedOp "/" <|> reservedOp "÷" <|> reserved "per"
    mulOp = reservedOp "*" <|> reservedOp "·" <|> reservedOp "⋅"
                           <|> reservedOp "×"
    subOp = reservedOp "-"
    addOp = reservedOp "+"
    arrOp = reservedOp "->" <|> reservedOp "→" <|> reserved "to"

    square q = BinOp Pow q (Scalar $ fromNumber 2.0)
    cube q = BinOp Pow q (Scalar $ fromNumber 3.0)

-- | Parse a mathematical expression (or conversion) like `3m+2in -> cm`.
fullExpression ∷ P Expression
fullExpression = do
  whiteSpace
  expr ← expression
  eof <?> "end of input"

  pure $ expr

-- | Parse an Insect command.
command ∷ P Command
command =
  (
        (reserved "help" <|> reserved "?") *> pure Help
    <|> (reserved "list" <|> reserved "ls" <|> reserved "ll") *> pure List
    <|> (reserved "reset") *> pure Reset
    <|> (reserved "clear" <|> reserved "cls") *> pure Clear
    <|> (reserved "quit" <|> reserved "exit") *> pure Quit
  ) <* eof

-- | Parse a variable assignment like `x = 3m*pi`
assignment ∷ P (Tuple String Expression)
assignment = do
  whiteSpace
  var ← token.identifier
  reservedOp "="
  value ← expression
  eof
  pure $ Tuple var value

-- | Try to parse the identifier as a unit, and fail if it succeeds.
checkIdentifier ∷ Tuple String Expression → P Statement
checkIdentifier (Tuple var value) =
  case runParser var (derivedUnit <* eof) of
    Right _ →
      fail $ "'" <> var <> "' is reserved for a physical unit"
    Left _ →
      case runParser var (funcName <* eof) of
        Right _ →
          fail $ "'" <> var <> "' is reserved for a math. function"
        Left _ →
          pure $ Assignment var value

-- | Parse a statement in the Insect language.
statement ∷ P Statement
statement =
      (Command <$> command)
  <|> (try assignment >>= checkIdentifier)
  <|> (Expression <$> fullExpression)

-- | Run the Insect-parser on a `String` input.
parseInsect ∷ String → Either ParseError Statement
parseInsect inp = runParser inp statement


stub ex1

stub ex1

module Example.One where

import Prelude

error: pathspec 'src/Example/One.purs' did not match any file(s) known to git


Parser again

Parser again

module JSON where

  import Prelude
  import Either
  import Monad

  foreign import data JSON :: *

  foreign import fromString "function fromString (str) { \
                            \  try { \
                            \    return _ps.Either.Right(JSON.parse(str)); \
                            \  } catch (e) { \
                            \    return _ps.Either.Left(e.toString()); \
                            \  } \
                            \}" :: String -> Either String JSON

  foreign import readPrimType "function readPrimType (typeName) { \
                              \  return function (value) { \
                              \    if (toString.call(value) == '[object ' + typeName + ']') { \
                              \      return _ps.Either.Right(value);\
                              \    } \
                              \    return _ps.Either.Left('Value is not a ' + typeName + ''); \
                              \  }; \
                              \}" :: forall a. String -> JSON -> Either String a

  foreign import readMaybe "function readMaybe (value) { \
                           \  return value === undefined || value === null ? _ps.Maybe.Nothing : _ps.Maybe.Just(value); \
                           \}" :: forall a. JSON -> Maybe.Maybe JSON

  foreign import readProp "function prop (k) { \
                          \  return function (obj) { \
                          \    return _ps.Either.Right(obj[k]);\
                          \  }; \
                          \}" :: forall a. String -> JSON -> Either String JSON

  foreign import showJSON "function showJSON (obj) { \
                          \  return JSON.stringify(obj); \
                          \}" :: JSON -> String

  instance Prelude.Show JSON where
    show = showJSON

  data JSONParser a = JSONParser (JSON -> Either String a)

  str :: JSONParser String
  str = JSONParser $ readPrimType "String"

  num :: JSONParser Number
  num = JSONParser $ readPrimType "Number"

  bool :: JSONParser Boolean
  bool = JSONParser $ readPrimType "Boolean"

  arr :: JSONParser [JSON]
  arr = JSONParser $ readPrimType "Array"

  maybe :: JSONParser (Maybe.Maybe JSON)
  maybe = JSONParser $ Right <<< readMaybe

  prop :: String -> JSONParser JSON
  prop p = JSONParser \x -> readProp p x

  runParser :: forall a. JSONParser a -> JSON -> Either String a
  runParser (JSONParser p) x = p x

  instance Prelude.Monad JSONParser where
    return x = JSONParser \_ -> Right x
    (>>=) (JSONParser p) f = JSONParser \x -> case p x of
        Left err -> Left err
        Right x' -> runParser (f x') x

error: pathspec 'parser.purs' did not match any file(s) known to git


prefer wildcard to hardcoded type

prefer wildcard to hardcoded type

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/michaelsbradleyjr/advent-of-code.git/'


add Core file with compiler functions

add Core file with compiler functions

module Ifrit.Core where

import Prelude

import Control.Monad.State(evalStateT)
import Data.Argonaut.Core(Json)
import Data.Argonaut.Encode(encodeJson)
import Data.Either(Either)

import Ifrit.Lexer as Lexer
import Ifrit.Parser as Parser
import Ifrit.Semantic as Semantic
import Ifrit.Driver.MongoDB as MongoDB

class Compile driver where
  compile :: Json -> String -> Either String { schema :: Json, output :: driver }

newtype MongoDB = MongoDB Json

instance compileMongoDB :: Compile MongoDB where
  compile inputSchema input = do
    schemaIn <- Semantic.fromJson inputSchema
    tokens <- evalStateT Lexer.tokenize { pos: 0, str: input }
    ast :: Parser.Statement <- evalStateT Parser.parse tokens
    schema <- Semantic.analyze schemaIn ast
    output <- MongoDB.ingest ast
    pure { schema: encodeJson schema, output: MongoDB output }

error: pathspec 'src/Ifrit/Core.purs' did not match any file(s) known to git


Add basic auth tests

Add basic auth tests

module Hyper.Node.BasicAuthSpec where

import Prelude
import Data.StrMap as StrMap
import Data.Maybe (Maybe(Nothing, Just))
import Data.Tuple (fst, Tuple(Tuple))
import Hyper.Node.BasicAuth (withAuthentication)
import Hyper.Test.TestServer (testResponseWriter)
import Node.Buffer (BUFFER)
import Test.Spec (it, Spec, describe)
import Test.Spec.Assertions (shouldEqual)

spec :: forall e. Spec (buffer :: BUFFER | e) Unit
spec =
  describe "Hyper.Node.BasicAuth" do

    it "extracts basic authentication from header when correct" do
      response <- { request: { headers: StrMap.singleton "authorization" "Basic dXNlcjpwYXNz" }
                  , response: { writer: testResponseWriter }
                  , components: { authentication: unit }
                  }
                  # withAuthentication (pure <<< Just)
      response.components.authentication `shouldEqual` Just (Tuple "user" "pass")

    it "extracts no information if the header is missing" do
      response <- { request: { headers: StrMap.empty }
                  , response: { writer: testResponseWriter }
                  , components: { authentication: unit }
                  }
                  # withAuthentication (pure <<< Just)
      response.components.authentication `shouldEqual` Nothing

    it "extracts no information if the header lacks the \"Basic\" string" do
      response <- { request: { headers: StrMap.singleton "authorization" "dXNlcjpwYXNz" }
                  , response: { writer: testResponseWriter }
                  , components: { authentication: unit }
                  }
                  # withAuthentication (pure <<< Just)
      response.components.authentication `shouldEqual` Nothing

    it "uses the value returned by the mapper function" do
      response <- { request: { headers: StrMap.singleton "authorization" "Basic dXNlcjpwYXNz" }
                  , response: { writer: testResponseWriter }
                  , components: { authentication: unit }
                  }
                  # withAuthentication (pure <<< Just <<< fst)
      response.components.authentication `shouldEqual` (Just "user")

error: pathspec 'test/Hyper/Node/BasicAuthSpec.purs' did not match any file(s) known to git


Reorganized for better reading.

Reorganized for better reading.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/0dB/cats-utils.git/'


Removed internalExternal() and adjusted layout accordingly.


Introduced toIO function

Introduced toIO function

module Gonimo.Client.Types where

import Prelude
import Servant.PureScript.Affjax as Affjax
import Browser.LocalStorage (STORAGE)
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.Class (liftAff, class MonadAff)
import Control.Monad.Eff.Class (liftEff, class MonadEff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Exception (Error, EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import Control.Monad.Error.Class (catchError, throwError)
import Control.Monad.Except.Trans (runExceptT, class MonadError, ExceptT)
import Control.Monad.IO (IO)
import Control.Monad.Reader.Class (local, ask, class MonadReader)
import Control.Monad.Reader.Trans (runReaderT, ReaderT)
import Data.Either (Either(Right, Left), either)
import Data.Generic (class Generic)
import Gonimo.WebAPI (SPParams_)
import Gonimo.WebAPI.Types (DeviceInfo)
import Network.HTTP.Affjax (AJAX)
import Servant.PureScript.Affjax (AjaxError)
import Servant.PureScript.Settings (SPSettings_)
import Signal.Channel (CHANNEL)
import WebSocket (WEBSOCKET)

type Settings = SPSettings_ SPParams_

data GonimoError = AjaxError Affjax.AjaxError
                 | UnexpectedAction String

-- | Action type to use when errors should be handled by the parent component.
data ReportParent action = ReportError GonimoError
                         | Child action

-- | Action types that can be used for error reporting:
class ReportErrorAction action where
  reportError :: GonimoError -> action

instance reportErrorActionReportParent :: ReportErrorAction (ReportParent action) where
  reportError = ReportError

type GonimoEff eff = ( ajax :: AJAX
                      , channel :: CHANNEL
                      , console :: CONSOLE
                      , storage :: STORAGE
                      , ws :: WEBSOCKET
                      , err :: EXCEPTION
                      , ref :: REF | eff
                      )

newtype GonimoT eff a = GonimoT (ReaderT Settings (ExceptT GonimoError (Aff eff)) a)

type Gonimo eff = GonimoT (GonimoEff eff)

runGonimoT :: forall eff a. GonimoT eff a -> (ReaderT Settings (ExceptT GonimoError (Aff eff)) a)
runGonimoT (GonimoT m) = m

toAff :: forall eff action. ReportErrorAction action
         => Settings -> Gonimo eff action -> Aff (GonimoEff eff) action
toAff settings m = do
  map (either reportError id) <<< runExceptT <<< flip runReaderT settings <<< runGonimoT $ m

toIO :: forall eff action. ReportErrorAction action
        => Settings -> Gonimo eff action -> IO action
toIO settings m = liftAff $ toAff settings m

instance functorGonimoT :: Functor (GonimoT eff) where
  map f (GonimoT m) = GonimoT $ map f m

instance applyGonimoT :: Apply (GonimoT eff) where
  apply (GonimoT mf) (GonimoT ma) = GonimoT $ apply mf ma

instance applicativeGonimoT :: Applicative (GonimoT eff) where
  pure = GonimoT <<< pure

instance bindGonimoT :: Bind (GonimoT eff) where
  bind (GonimoT ma) mf = GonimoT $ bind ma (runGonimoT <<< mf)

instance monadGonimoT :: Monad (GonimoT eff)

instance monadReaderSettingsGonimoT :: MonadReader (SPSettings_ SPParams_) (GonimoT eff) where
  ask = GonimoT ask
  --local :: forall a. (r -> r) -> m a -> m a
  local f (GonimoT ma) = GonimoT (local f ma)

instance monadErrorErrorGonimoT :: MonadError GonimoError (GonimoT eff) where
  throwError = GonimoT <<< throwError
  catchError (GonimoT ma) ef = GonimoT $ catchError ma (runGonimoT <<< ef)

instance monadErrorAjaxErrorGonimoT :: MonadError AjaxError (GonimoT eff) where
  throwError = GonimoT <<< throwError <<< AjaxError
  catchError (GonimoT ma) ef = GonimoT $ catchError ma (runGonimoT <<< handleAjax)
    where
      handleAjax (AjaxError err) = ef err
      handleAjax err = throwError err

instance monadEffeffGonimoT :: MonadEff eff (GonimoT eff) where
  liftEff = GonimoT <<< liftEff

instance monadAffeffGonimoT :: MonadAff eff (GonimoT eff) where
  liftAff = GonimoT <<< liftAff

-- | Info about an online baby station.
type BabyStationInfo =
  { deviceInfo :: DeviceInfo
  , babyName :: String
  }

module Gonimo.Client.Types where

import Prelude
import Servant.PureScript.Affjax as Affjax
import Browser.LocalStorage (STORAGE)
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.Class (liftAff, class MonadAff)
import Control.Monad.Eff.Class (liftEff, class MonadEff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Exception (Error, EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import Control.Monad.Error.Class (catchError, throwError)
import Control.Monad.Except.Trans (runExceptT, class MonadError, ExceptT)
import Control.Monad.Reader.Class (local, ask, class MonadReader)
import Control.Monad.Reader.Trans (runReaderT, ReaderT)
import Data.Either (Either(Right, Left), either)
import Data.Generic (class Generic)
import Gonimo.WebAPI (SPParams_)
import Network.HTTP.Affjax (AJAX)
import Servant.PureScript.Affjax (AjaxError)
import Servant.PureScript.Settings (SPSettings_)
import Signal.Channel (CHANNEL)
import WebSocket (WEBSOCKET)
import Gonimo.WebAPI.Types (DeviceInfo)

type Settings = SPSettings_ SPParams_

data GonimoError = AjaxError Affjax.AjaxError
                 | UnexpectedAction String

-- | Action type to use when errors should be handled by the parent component.
data ReportParent action = ReportError GonimoError
                         | Child action

-- | Action types that can be used for error reporting:
class ReportErrorAction action where
  reportError :: GonimoError -> action

instance reportErrorActionReportParent :: ReportErrorAction (ReportParent action) where
  reportError = ReportError

type GonimoEff eff = ( ajax :: AJAX
                      , channel :: CHANNEL
                      , console :: CONSOLE
                      , storage :: STORAGE
                      , ws :: WEBSOCKET
                      , err :: EXCEPTION
                      , ref :: REF | eff
                      )

newtype GonimoT eff a = GonimoT (ReaderT Settings (ExceptT GonimoError (Aff eff)) a)

type Gonimo eff = GonimoT (GonimoEff eff)

runGonimoT :: forall eff a. GonimoT eff a -> (ReaderT Settings (ExceptT GonimoError (Aff eff)) a)
runGonimoT (GonimoT m) = m

toAff :: forall eff action. ReportErrorAction action
         => Settings -> Gonimo eff action -> Aff (GonimoEff eff) action
toAff settings m = do
  map (either reportError id) <<< runExceptT <<< flip runReaderT settings <<< runGonimoT $ m

instance functorGonimoT :: Functor (GonimoT eff) where
  map f (GonimoT m) = GonimoT $ map f m

instance applyGonimoT :: Apply (GonimoT eff) where
  apply (GonimoT mf) (GonimoT ma) = GonimoT $ apply mf ma

instance applicativeGonimoT :: Applicative (GonimoT eff) where
  pure = GonimoT <<< pure

instance bindGonimoT :: Bind (GonimoT eff) where
  bind (GonimoT ma) mf = GonimoT $ bind ma (runGonimoT <<< mf)

instance monadGonimoT :: Monad (GonimoT eff)

instance monadReaderSettingsGonimoT :: MonadReader (SPSettings_ SPParams_) (GonimoT eff) where
  ask = GonimoT ask
  --local :: forall a. (r -> r) -> m a -> m a
  local f (GonimoT ma) = GonimoT (local f ma)

instance monadErrorErrorGonimoT :: MonadError GonimoError (GonimoT eff) where
  throwError = GonimoT <<< throwError
  catchError (GonimoT ma) ef = GonimoT $ catchError ma (runGonimoT <<< ef)

instance monadErrorAjaxErrorGonimoT :: MonadError AjaxError (GonimoT eff) where
  throwError = GonimoT <<< throwError <<< AjaxError
  catchError (GonimoT ma) ef = GonimoT $ catchError ma (runGonimoT <<< handleAjax)
    where
      handleAjax (AjaxError err) = ef err
      handleAjax err = throwError err

instance monadEffeffGonimoT :: MonadEff eff (GonimoT eff) where
  liftEff = GonimoT <<< liftEff

instance monadAffeffGonimoT :: MonadAff eff (GonimoT eff) where
  liftAff = GonimoT <<< liftAff

-- | Info about an online baby station.
type BabyStationInfo =
  { deviceInfo :: DeviceInfo
  , babyName :: String
  }


define lifted console functions

define lifted console functions

module Effect.Class.Console where

import Data.Function ((<<<))
import Data.Show (class Show)
import Data.Unit (Unit)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Console as EffConsole

log :: forall m. MonadEffect m => String -> m Unit
log = liftEffect <<< EffConsole.log

logShow :: forall m a. MonadEffect m => Show a => a -> m Unit
logShow = liftEffect <<< EffConsole.logShow

warn :: forall m. MonadEffect m => String -> m Unit
warn = liftEffect <<< EffConsole.warn

warnShow :: forall m a. MonadEffect m => Show a => a -> m Unit
warnShow = liftEffect <<< EffConsole.warnShow

error :: forall m. MonadEffect m => String -> m Unit
error = liftEffect <<< EffConsole.error

errorShow :: forall m a. MonadEffect m => Show a => a -> m Unit
errorShow = liftEffect <<< EffConsole.errorShow

info :: forall m. MonadEffect m => String -> m Unit
info = liftEffect <<< EffConsole.info

infoShow :: forall m a. MonadEffect m => Show a => a -> m Unit
infoShow = liftEffect <<< EffConsole.infoShow

error: pathspec 'src/Effect/Class/Console.purs' did not match any file(s) known to git


Re-organized.

Re-organized.


Improve rendering of requests

Improve rendering of requests

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/clample/lambdabtc.git/'


Add Language.PureScript.Keywords

Add Language.PureScript.Keywords

module Language.PureScript.Keywords where

import Data.String (split)

-- |
-- A list of purescript reserved identifiers
--
reservedPsNames :: [String]
reservedPsNames =
  [ "data"
  , "type"
  , "foreign"
  , "import"
  , "infixl"
  , "infixr"
  , "infix"
  , "class"
  , "instance"
  , "module"
  , "case"
  , "of"
  , "if"
  , "then"
  , "else"
  , "do"
  , "let"
  , "true"
  , "false"
  , "in"
  , "where" ]

-- |
-- A list of additionally reserved identifiers for types
--
reservedTypeNames :: [String]
reservedTypeNames =
  [ "forall"
  , "where" ]

-- |
-- The characters allowed for use in operators
--
opChars :: [String]
opChars = split "" ":!#$%&*+./<=>?@\\^|-~"

-- |
-- A list of reserved operators
--
reservedOpNames :: [String]
reservedOpNames =
  [ "=>"
  , "->"
  , "="
  , "."
  , "\\" ]

error: pathspec 'src/Language/PureScript/Keywords.purs' did not match any file(s) known to git


Learned how record types can share rows.


Show position for parse errors

Show position for parse errors

module Insect (
  repl
  ) where

import Prelude hiding (degree)

import Control.Alt ((<|>))
import Control.Apply (lift2)
import Control.Lazy (fix)

import Data.Quantity
import Data.Quantity.Math

import Data.Units
import Data.Units.SI
import Data.Units.SI.Derived
import Data.Units.SI.Accepted
import Data.Units.Imperial
import Data.Units.Time
import Data.Units.Bit

import Data.Either (Either(..), either)
import Data.Int (toNumber)

import Text.Parsing.Parser
import Text.Parsing.Parser.Combinators
import Text.Parsing.Parser.Expr
import Text.Parsing.Parser.String
import Text.Parsing.Parser.Pos (Position(..))
import Text.Parsing.Parser.Token hiding (token)

type Expect = Either UnificationError
type P a = Parser String a

languageDef :: LanguageDef
languageDef = LanguageDef
  { commentStart: ""
  , commentEnd: ""
  , commentLine: "#"
  , nestedComments: false
  , identStart: letter
  , identLetter: alphaNum <|> char '_'
  , opStart: oneOf ['+', '-', '*', '/', '^', '=']
  , opLetter: oneOf ['>']
  , reservedNames: []
  , reservedOpNames: ["->", "+", "-", "*", "/", "^", "="]
  , caseSensitive: true
}

token :: TokenParser
token = makeTokenParser languageDef

-- TODO: this does not parse huge decimals correctly, as they are converted
-- to Int first
pNumber :: P Number
pNumber = either toNumber id <$> token.naturalOrFloat

parens :: ∀ a. P a -> P a
parens = token.parens

reservedOp :: String -> P Unit
reservedOp = token.reservedOp

reserved :: String -> P Unit
reserved = token.reserved

white :: P Unit
white = token.whiteSpace

{--
pNumber :: P Number
pNumber = do
  intPart <- signAndDigits

  mFracPart <- optionMaybe (append <$> string "." <*> digits)
  let fracPart = fromMaybe "" mFracPart

  mExpPart <- optionMaybe (append <$> string "e" <*> signAndDigits)
  let expPart = fromMaybe "" mExpPart

  let num = readFloat (intPart <> fracPart <> expPart)

  if isFinite num
    then pure num
    else fail "Could not parse Number"

  where
    digits :: P String
    digits = do
      ds <- some $ oneOf ['0', '1', '2']
      pure $ fromCharArray (fromFoldable ds)

    signAndDigits :: P String
    signAndDigits = do
      sign <- singleton <$> option '+' (oneOf ['+', '-'])
      intPart <- digits
      pure $ sign <> intPart
--}

pSIPrefix :: P (DerivedUnit → DerivedUnit)
pSIPrefix =
      (string "a" *> pure atto)
  <|> (string "f" *> pure femto)
  <|> (string "p" *> pure pico)
  <|> (string "n" *> pure nano)
  <|> (string "µ" *> pure micro)
  <|> (string "m" *> pure milli)
  <|> (string "c" *> pure centi)
  <|> (string "d" *> pure deci)
  <|> (string "h" *> pure hecto)
  <|> (string "k" *> pure kilo)
  <|> (string "M" *> pure mega)
  <|> (string "G" *> pure giga)
  <|> (string "T" *> pure tera)
  <|> (string "P" *> pure peta)
  <|> (string "E" *> pure exa)
  <|> pure id

pNormalUnit :: P DerivedUnit
pNormalUnit =
      (string "radians" *> pure radian)
  <|> (string "radian"  *> pure radian)
  <|> (string "rad"     *> pure radian)
  <|> (string "degrees" *> pure degree)
  <|> (string "degree"  *> pure degree)
  <|> (string "deg"     *> pure degree)
  <|> (string "hertz"   *> pure hertz)
  <|> (string "Hz"      *> pure hertz)
  <|> (string "N"       *> pure newton)
  <|> (string "J"       *> pure joule)
  <|> (string "W"       *> pure watt)
  <|> (string "bytes"   *> pure byte)
  <|> (string "byte"    *> pure byte)
  <|> (string "bits"    *> pure bit)
  <|> (string "bit"     *> pure bit)
  <|> (string "bps"     *> pure (bit ./ second))
  <|> (string "b"       *> pure byte)
  <|> (string "sec"     *> pure second)
  <|> (string "min"     *> pure minute)
  <|> (string "hours"   *> pure hour)
  <|> (string "hour"    *> pure hour)
  <|> (string "h"       *> pure hour)
  <|> (string "days"    *> pure day)
  <|> (string "day"     *> pure day)
  <|> (string "d"       *> pure day)
  <|> (string "weeks"   *> pure week)
  <|> (string "week"    *> pure week)
  <|> (string "kmh"     *> pure (kilo meter ./ hour))
  <|> (string "m/h"     *> pure (meter ./ hour)) -- TODO: handle this differently
  <|> (string "m/s"     *> pure (meter ./ second)) -- TODO: handle this differently
  <|> (string "g"       *> pure gram)
  <|> (string "m"       *> pure meter)
  <|> (string "s"       *> pure second)
  <?> "Expected unit"

pImperialUnit :: P DerivedUnit
pImperialUnit =
      (string "miles"  *> pure mile)
  <|> (string "mile"   *> pure mile)
  -- <|> (string "mi"     *> pure mile)    TODO: this is incompatible with 'min'
  <|> (string "mph"    *> pure (mile ./ hour))
  <|> (string "inches" *> pure inch)
  <|> (string "inch"   *> pure inch)
  <|> (string "in"     *> pure inch)
  <|> (string "yards"  *> pure yard)
  <|> (string "yard"   *> pure yard)
  <|> (string "yd"     *> pure yard)
  <|> (string "feet"   *> pure foot)
  <|> (string "foot"   *> pure foot)
  <|> (string "ft"     *> pure foot)
  <|> (string "ounces" *> pure ounce)
  <|> (string "ounce"  *> pure ounce)
  <|> (string "oz"     *> pure ounce)
  <|> (string "pound"  *> pure pound)
  <|> (string "lb"     *> pure pound)

pUnitWithSIPrefix :: P DerivedUnit
pUnitWithSIPrefix = do
  p <- pSIPrefix
  u <- pNormalUnit
  pure $ p u

pUnit :: P DerivedUnit
pUnit = try pUnitWithSIPrefix
    <|> try pImperialUnit
    <|> try pNormalUnit
    <|> pure unity

pQuantity :: P Quantity
pQuantity = quantity <$> pNumber <*> pUnit

qS ea eb = do
  a <- ea
  b <- eb
  a ⊖ b

qA ea eb = do
  a <- ea
  b <- eb
  a ⊕ b

qPow eBase eExp = do
  base <- eBase
  exp <- eExp
  expNumber <- exp `asValueIn` unity
  pure $ base `pow` expNumber

pTerm :: P (Expect Quantity) -> P (Expect Quantity)
pTerm p = parens p <|> (Right <$> pQuantity)

pExpr :: P (Expect Quantity)
pExpr = fix \p ->
  buildExprParser [ [ Infix (reservedOp "/" $> lift2 (⊘)) AssocRight ]
                  , [ Infix (reservedOp "*" $> lift2 (⊗)) AssocRight ]
                  , [ Infix (reservedOp "-" $> qS) AssocRight ]
                  , [ Infix (reservedOp "+" $> qA) AssocRight ]
                  ] (pTerm p)

pConversion :: P (Expect Quantity)
pConversion = do
  expr <- pExpr
  white
  reservedOp "->"
  target <- pUnit
  eof
  pure (expr >>= (flip convertTo) target)

pInput :: P (Expect Quantity)
pInput = try pConversion <|> (pExpr <* eof)

repl :: String -> { out :: String, divClass :: String }
repl inp =
  case runParser inp pInput of
    Left pErr ->
      let pos = parseErrorPosition pErr
      in case pos of
           (Position rec) ->
             { out: "Parse error: " <> parseErrorMessage pErr <>
                    " at position " <> show rec.column
             , divClass: "error" }
    Right res ->
      case res of
        Left unificationError -> { out: errorMessage unificationError, divClass: "error" }
        Right val -> { out: prettyPrint val, divClass: "value" }

module Insect (
  repl
  ) where

import Prelude hiding (degree)

import Control.Alt ((<|>))
import Control.Apply (lift2)
import Control.Lazy (fix)

import Data.Quantity
import Data.Quantity.Math

import Data.Units
import Data.Units.SI
import Data.Units.SI.Derived
import Data.Units.SI.Accepted
import Data.Units.Imperial
import Data.Units.Time
import Data.Units.Bit

import Data.Either (Either(..), either)
import Data.Int (toNumber)

import Text.Parsing.Parser
import Text.Parsing.Parser.Combinators
import Text.Parsing.Parser.Expr
import Text.Parsing.Parser.String
import Text.Parsing.Parser.Token hiding (token)

type Expect = Either UnificationError
type P a = Parser String a

languageDef :: LanguageDef
languageDef = LanguageDef
  { commentStart: ""
  , commentEnd: ""
  , commentLine: "#"
  , nestedComments: false
  , identStart: letter
  , identLetter: alphaNum <|> char '_'
  , opStart: oneOf ['+', '-', '*', '/', '^', '=']
  , opLetter: oneOf ['>']
  , reservedNames: []
  , reservedOpNames: ["->", "+", "-", "*", "/", "^", "="]
  , caseSensitive: true
}

token :: TokenParser
token = makeTokenParser languageDef

-- TODO: this does not parse huge decimals correctly, as they are converted
-- to Int first
pNumber :: P Number
pNumber = either toNumber id <$> token.naturalOrFloat

parens :: ∀ a. P a -> P a
parens = token.parens

reservedOp :: String -> P Unit
reservedOp = token.reservedOp

reserved :: String -> P Unit
reserved = token.reserved

white :: P Unit
white = token.whiteSpace

{--
pNumber :: P Number
pNumber = do
  intPart <- signAndDigits

  mFracPart <- optionMaybe (append <$> string "." <*> digits)
  let fracPart = fromMaybe "" mFracPart

  mExpPart <- optionMaybe (append <$> string "e" <*> signAndDigits)
  let expPart = fromMaybe "" mExpPart

  let num = readFloat (intPart <> fracPart <> expPart)

  if isFinite num
    then pure num
    else fail "Could not parse Number"

  where
    digits :: P String
    digits = do
      ds <- some $ oneOf ['0', '1', '2']
      pure $ fromCharArray (fromFoldable ds)

    signAndDigits :: P String
    signAndDigits = do
      sign <- singleton <$> option '+' (oneOf ['+', '-'])
      intPart <- digits
      pure $ sign <> intPart
--}

pSIPrefix :: P (DerivedUnit → DerivedUnit)
pSIPrefix =
      (string "a" *> pure atto)
  <|> (string "f" *> pure femto)
  <|> (string "p" *> pure pico)
  <|> (string "n" *> pure nano)
  <|> (string "µ" *> pure micro)
  <|> (string "m" *> pure milli)
  <|> (string "c" *> pure centi)
  <|> (string "d" *> pure deci)
  <|> (string "h" *> pure hecto)
  <|> (string "k" *> pure kilo)
  <|> (string "M" *> pure mega)
  <|> (string "G" *> pure giga)
  <|> (string "T" *> pure tera)
  <|> (string "P" *> pure peta)
  <|> (string "E" *> pure exa)
  <|> pure id

pNormalUnit :: P DerivedUnit
pNormalUnit =
      (string "radians" *> pure radian)
  <|> (string "radian"  *> pure radian)
  <|> (string "rad"     *> pure radian)
  <|> (string "degrees" *> pure degree)
  <|> (string "degree"  *> pure degree)
  <|> (string "deg"     *> pure degree)
  <|> (string "hertz"   *> pure hertz)
  <|> (string "Hz"      *> pure hertz)
  <|> (string "N"       *> pure newton)
  <|> (string "J"       *> pure joule)
  <|> (string "W"       *> pure watt)
  <|> (string "bytes"   *> pure byte)
  <|> (string "byte"    *> pure byte)
  <|> (string "bits"    *> pure bit)
  <|> (string "bit"     *> pure bit)
  <|> (string "bps"     *> pure (bit ./ second))
  <|> (string "b"       *> pure byte)
  <|> (string "sec"     *> pure second)
  <|> (string "min"     *> pure minute)
  <|> (string "hours"   *> pure hour)
  <|> (string "hour"    *> pure hour)
  <|> (string "h"       *> pure hour)
  <|> (string "days"    *> pure day)
  <|> (string "day"     *> pure day)
  <|> (string "d"       *> pure day)
  <|> (string "weeks"   *> pure week)
  <|> (string "week"    *> pure week)
  <|> (string "kmh"     *> pure (kilo meter ./ hour))
  <|> (string "m/h"     *> pure (meter ./ hour)) -- TODO: handle this differently
  <|> (string "m/s"     *> pure (meter ./ second)) -- TODO: handle this differently
  <|> (string "g"       *> pure gram)
  <|> (string "m"       *> pure meter)
  <|> (string "s"       *> pure second)
  <?> "Expected unit"

pImperialUnit :: P DerivedUnit
pImperialUnit =
      (string "miles"  *> pure mile)
  <|> (string "mile"   *> pure mile)
  -- <|> (string "mi"     *> pure mile)    TODO: this is incompatible with 'min'
  <|> (string "mph"    *> pure (mile ./ hour))
  <|> (string "inches" *> pure inch)
  <|> (string "inch"   *> pure inch)
  <|> (string "in"     *> pure inch)
  <|> (string "yards"  *> pure yard)
  <|> (string "yard"   *> pure yard)
  <|> (string "yd"     *> pure yard)
  <|> (string "feet"   *> pure foot)
  <|> (string "foot"   *> pure foot)
  <|> (string "ft"     *> pure foot)
  <|> (string "ounces" *> pure ounce)
  <|> (string "ounce"  *> pure ounce)
  <|> (string "oz"     *> pure ounce)
  <|> (string "pound"  *> pure pound)
  <|> (string "lb"     *> pure pound)

pUnitWithSIPrefix :: P DerivedUnit
pUnitWithSIPrefix = do
  p <- pSIPrefix
  u <- pNormalUnit
  pure $ p u

pUnit :: P DerivedUnit
pUnit = try pUnitWithSIPrefix
    <|> try pImperialUnit
    <|> try pNormalUnit
    <|> pure unity

pQuantity :: P Quantity
pQuantity = quantity <$> pNumber <*> pUnit

qS ea eb = do
  a <- ea
  b <- eb
  a ⊖ b

qA ea eb = do
  a <- ea
  b <- eb
  a ⊕ b

qPow eBase eExp = do
  base <- eBase
  exp <- eExp
  expNumber <- exp `asValueIn` unity
  pure $ base `pow` expNumber

pTerm :: P (Expect Quantity) -> P (Expect Quantity)
pTerm p = parens p <|> (Right <$> pQuantity)

pExpr :: P (Expect Quantity)
pExpr = fix \p ->
  buildExprParser [ [ Infix (reservedOp "/" $> lift2 (⊘)) AssocRight ]
                  , [ Infix (reservedOp "*" $> lift2 (⊗)) AssocRight ]
                  , [ Infix (reservedOp "-" $> qS) AssocRight ]
                  , [ Infix (reservedOp "+" $> qA) AssocRight ]
                  ] (pTerm p)

pConversion :: P (Expect Quantity)
pConversion = do
  expr <- pExpr
  white
  reservedOp "->"
  target <- pUnit
  eof
  pure (expr >>= (flip convertTo) target)

pInput :: P (Expect Quantity)
pInput = try pConversion <|> (pExpr <* eof)

repl :: String -> { out :: String, divClass :: String }
repl inp =
  case runParser inp pInput of
    Left pErr ->
      let pos = parseErrorPosition pErr
      in { out: "Parse error: " <> parseErrorMessage pErr <>
                 " at position " <> show pos
          , divClass: "error" }
    Right res ->
      case res of
        Left unificationError -> { out: errorMessage unificationError, divClass: "error" }
        Right val -> { out: prettyPrint val, divClass: "value" }


Style fix

Style fix

module Gonimo.UI.Error ( class ErrorAction
                       , resetDevice
                       , nop
                       , clearError
                       , UserError(..)
                       , handleError
                       , handleSubscriber
                       , viewError ) where

import Data.Array as Arr
import Data.Unfoldable as Unfoldable
import Gonimo.Client.Effects as Gonimo
import Gonimo.Server.Error as Server
import Pux.Html.Attributes as A
import Pux.Html.Events as E
import Servant.PureScript.Affjax as Affjax
import Control.Monad.IO (IO)
import Control.Monad.State.Class (modify, class MonadState)
import Data.Either (Either(Left, Right), either)
import Data.Generic (gShow)
import Data.Maybe (fromMaybe, maybe, Maybe(Just, Nothing))
import Gonimo.Client.Types (GonimoError(RegisterSessionFailed, AjaxError, UnexpectedAction))
import Gonimo.Server.Error (ServerError)
import Pux.Html (div, button, p, h1, text, Html)
import Pux.Html.Attributes (offset)
import Servant.PureScript.Affjax (requestToString, ErrorDescription(ConnectionError), responseToString, unsafeToString, ErrorDescription(DecodingError, ParsingError, UnexpectedHTTPStatus))
import Servant.Subscriber.Connection (Notification(HttpRequestFailed, ParseError, WebSocketClosed, WebSocketOpened, WebSocketError))
import Servant.Subscriber.Internal (doDecode)
import Servant.Subscriber.Request (HttpRequest)
import Servant.Subscriber.Response (HttpResponse(HttpResponse))
import Servant.Subscriber.Util (toUserType)
import Prelude hiding (div)

type State r = { userError :: UserError | r }

class ErrorAction action where
  resetDevice :: action
  clearError :: action
  nop :: action

-- | Errors which are of concern for the user and should be displayed.
data UserError = NoError
               | DeviceInvalid -- Server does not accept our device secret.
               | AlreadyFamilyMember
               | NoSuchFamily
               | FamilyNotOnline
               | NoSuchInvitation
               | InvitationAlreadyClaimed
               | ConnectionFailed

handleError :: forall eff r m action. ( ErrorAction action, MonadState (State r) m )
               => GonimoError -> m (Array (IO action))
handleError err = case err of
  UnexpectedAction msg -> logError "An unexpected action occurred: " msg
  RegisterSessionFailed err -> handleAjaxError err
  AjaxError err -> handleAjaxError err

handleAjaxError :: forall r m action. ( ErrorAction action, MonadState (State r) m )
                   => Affjax.AjaxError -> m (Array (IO action))
handleAjaxError (Affjax.AjaxError err) = case err.description of
  ParsingError msg -> logError "Parsing error in Ajax request: " msg
  DecodingError msg -> logError "Decoding error in Ajax request: " msg
  ConnectionError msg -> do
    modify $ setError ConnectionFailed
    logError "Ajax request failed: " msg
  UnexpectedHTTPStatus response ->
    handleEncodedServerError (requestToString err.request) (responseToString response) response.response

handleSubscriber :: forall r m action. ( ErrorAction action, MonadState (State r) m )
                    => Notification -> m (Array (IO action))
handleSubscriber notification =
  case notification of
    WebSocketError msg           -> logError "A websocket error occurred: " msg
    WebSocketOpened              -> logError "WebSocket connection established!" ""
    WebSocketClosed msg          -> logError "The websocket connection got closed: " msg
    ParseError msg               -> logError "A parsing error occurred: " msg
    HttpRequestFailed req' resp' -> handleFailedHttpRequest req' resp'

handleFailedHttpRequest :: forall r m action. ( ErrorAction action, MonadState (State r) m )
                           => HttpRequest -> HttpResponse -> m (Array (IO action))
handleFailedHttpRequest req' fResp@(HttpResponse resp') =
  handleEncodedServerError (gShow req') (gShow fResp) resp'.httpBody

handleEncodedServerError :: forall r m action. ( ErrorAction action, MonadState (State r) m )
                            => String -> String -> String -> m (Array (IO action))
handleEncodedServerError req' resp' value = do
  modify updateState
  pure [ case decodingResult of
            Right _ ->  do
              Gonimo.log "Got server error!"
              Gonimo.log $ "For request: " <> req'
              Gonimo.log $ "Response was: " <> resp'
              pure nop

            Left err ->  do
              Gonimo.log $ "Decoding error while handling failed http request: " <> err
              Gonimo.log $ "For request: " <> req'
              Gonimo.log $ "Response was: " <> resp'
              pure nop
       ]
  where
    updateState state = case error of
        NoError -> state
        _       -> setError error state
    fromServer = fromMaybe NoError <<< ( fromServerError =<< _ )
    decodingResult = doDecode (toUserType fromServer) value
    error = either (const NoError) id decodingResult

viewError :: forall r action. ErrorAction action
             => State r -> Html action
viewError state = case state.userError of
  NoError -> text "No error occurred - everything is fine!"
  DeviceInvalid -> errorView (Just resetDevice) "Your account is no longer valid"
    $ div []
      [ p []
        [ text  "We are sorry, but your account is no longer known by our server." ]
      , p []
        [ text
          $ "To proceed I would create a new account for you. You will have to rejoin any "
          <> "families you were in already."
        ]
      , p [] [ text "I am sorry for any inconveniences!" ]
      ]
  AlreadyFamilyMember -> errorView (Just clearError) "You are already a member of this family!"
    $ div []
      [ p [] [ text "You cannot join a family you are already a member of."]
      , p [] [ text $ "If you want to invite another device, please send another invitation."
                    <>"The link you just used, is now invalid! (Security, you know ... )"
             ]
      ]
  ConnectionFailed -> errorView (Just clearError) "No Internet Connection?"
    $ div []
      [ p [] [ text "We cannot reach our server."]
      , p [] [ text "Please make sure that you have a working internet connection and try again."
             ]
      ]
  NoSuchFamily -> errorView (Just clearError) "Your family no longer exists!"
    $ div []
      [ p [] [ text "It probably got deleted, we are sorry about that."]
      ]
  FamilyNotOnline -> errorView (Just clearError) "Your family is not online!"
    $ div []
      [ p [] [ text "This should not happen - like ever, if it happens, this is a bug. It can also happen if you open gonimo on multiple tabs in the same browser - which currently is not prevented (also a shortcoming of the current version)."]
      ]
  InvitationAlreadyClaimed -> errorView (Just clearError) "This invitation is already claimed!"
    $ div []
      [ p [] [ text "Another device already claimed this invitation."]
      , p [] [ text $ "Only this other device is now able to accept or decline the invitation."
             ]
      , p [] [ text "Security and stuff ...." ]
      ]
  NoSuchInvitation -> errorView (Just clearError) "This invitation no longer exists!"
    $ div []
      [ p [] [ text "For security reasons, invitations are only valid once."]
      , p [] [ text $ "Please send a new invitation from a device already in the family you were about to join."
             ]
      ]

errorView :: forall action. ErrorAction action
             => Maybe action -> String -> Html action -> Html action
errorView = errorView' "Proceed"

errorView' :: forall action. ErrorAction action
             => String -> Maybe action -> String -> Html action -> Html action
errorView' btnText action heading body =
    div [ A.className "alert alert-danger", A.role "alert" ]
    $ [ h1 [] [ text heading ]
      , body
      ]
      <> Arr.fromFoldable (map renderButton action)
  where
    renderButton :: action -> Html action
    renderButton action =
      div [ A.className "btn-group", A.role "group" ]
      [ button
        [ A.className "btn btn-danger btn-lg btn-block", E.onClick $ const action ]
        [ text btnText ]
      ]

logError :: forall action m. (ErrorAction action, Applicative m)
                 => String -> String -> m (Array (IO action))
logError prefix msg = pure [ do
                              Gonimo.log $ prefix <> msg
                              pure nop
                           ]

fromServerError :: ServerError -> Maybe UserError
fromServerError err = case err of
    Server.InvalidAuthToken         -> Just DeviceInvalid
    Server.AlreadyFamilyMember      -> Just AlreadyFamilyMember
    Server.NoSuchFamily _           -> Just NoSuchFamily
    Server.FamilyNotOnline _        -> Just FamilyNotOnline
    Server.InvitationAlreadyClaimed -> Just InvitationAlreadyClaimed
    Server.NoSuchInvitation         -> Just NoSuchInvitation
    _                               -> Nothing

-- | Sets userError in state but only if it was NoError before. (Does not overwrite an existing error)
setError :: forall r. UserError -> (State r) -> (State r)
setError error state = case state.userError of
  NoError -> state { userError = error }
  _ -> state


Add Parser for 'Atom's

Add Parser for 'Atom's

module Parser where

import Global              (readInt)
import Data.String         (joinWith, split)
import Data.Identity       (Identity())
import Control.Alt         ((<|>))
import Control.Apply       ((*>))
import Control.Alternative (some, many)

import Text.Parsing.Parser
import Text.Parsing.Parser.Combinators
import Text.Parsing.Parser.String

import AST

eatSpaces :: Parser String Unit
eatSpaces = void $ many $ string " " <|> string "\t"

num :: Parser String Atom
num = do
  sign <- option "" (string "-")
  eatSpaces
  str <- string "0" <|> nat
  return $ Num $ readInt 10 $ sign ++ str
  where
  nat = do
    d <- oneOf $ split "" "123456789"
    ds <- many $ oneOf $ split "" "0123456789"
    return $ joinWith "" $ d:ds

bool :: Parser String Atom
bool = do
  f <|> t
  where
  f = string "false" *> return (Bool false)
  t = string "true" *> return (Bool true)

name :: Parser String String
name = do
  str <- some $ oneOf $ split "" "_abcdefghijklmnopqrstuvwxyz'"
  return $ joinWith "" str

atom :: Parser String Atom
atom = do
  eatSpaces
  num <|> try bool <|> (Name <$> name) <?> "Atom (Number, Boolean, Name)"

error: pathspec 'src/Parser.purs' did not match any file(s) known to git


More appropriate interim stage for morphing.


Add a simple test file

Add a simple test file

module Main where

import Debug.Trace

import Data.Either

import Control.Apply

import Language.PureScript.Parser.Lexer
import Language.PureScript.Parser.Common
import Language.PureScript.Parser.Declarations

import Language.PureScript.Supply
import Language.PureScript.Sugar

example =
  "module Test where\n\
  \\n\
  \  foo :: Number -> Number\n\
  \  foo 0 = 1\n\
  \  foo 1 = 0\n\
  \  foo n = n"

main = do
  trace "Lexing source file"
  case lex example of
    Left err -> trace err
    Right tokens -> do
      trace $ "Tokens: " ++ show tokens
      trace "Parsing module"
      case runTokenParser (parseModule <* eof) tokens of
        Left err -> trace err
        Right mod -> do
          trace $ "Module: " ++ show mod
          trace "Desugaring module"
          case evalSupplyT 0 (desugar [mod]) of
            Left err -> print err
            Right [mod'] -> do
              trace $ "Desugared: " ++ show mod'

error: pathspec 'tests/TestSimple.purs' did not match any file(s) known to git


Animate demo site via a function

Animate demo site via a function

module Site where

import Control.Monad.Eff
import Css.Animation
import Css.Background
import Css.Border
import Css.Color
import Css.Display
import Css.Elements
import Css.Font
import Css.FontFace
import Css.Geometry
import Css.Gradient
import Css.Pseudo
import Css.Render
import Css.Selector
import Css.Size
import Css.String
import Css.Stylesheet
import Css.Text
import Css.Time
import Css.Transform
import Css.Transition
import Data.Maybe
import Data.Tuple.Nested
import DOM
import qualified Data.Array.NonEmpty as NEL

foreign import addStyleSheet """
  function addStyleSheet (s) {
    return function () {
      var e = document.createElement('style');
      e.appendChild(document.createTextNode(s));
      document.head.appendChild(e);
    };
  }
  """ :: String -> Eff (dom :: DOM) Unit

foreign import titleWidth """
  function titleWidth () {
    return document.getElementById('title').offsetWidth;
  }
  """ :: Eff (dom :: DOM) Number

foreign import titleHeight """
  function titleHeight () {
    return document.getElementById('title').offsetHeight;
  }
  """ :: Eff (dom :: DOM) Number

foreign import titleStyle """
  function titleStyle (s) {
    return function () {
      document.getElementById('title').setAttribute('style', s);
    };
  }
  """ :: String -> Eff (dom :: DOM) Unit

blue1 :: Color
blue1 = rgb 51 136 204

blue2 :: Color
blue2 = rgb 238 238 255

backgroundGradient :: forall a. Angle a -> Css
backgroundGradient a = backgroundImage $ linearGradient a (ColorPoint white (pct 0)) [] (ColorPoint blue2 (pct 100))

shake :: (Number -> Number) -> Css
shake f = transforms [translate (px (f 3)) nil, rotate (deg (f 2))]

style :: Css
style = do
  fontFace $ do
    fontFaceFamily $ fromString "Lato"
    fontWeight $ weight 300
    fontFaceSrc $ FontFaceSrcLocal "Lato Light" NEL.:|
                [ FontFaceSrcLocal "Lato-Light"
                , FontFaceSrcUrl "http://fonts.gstatic.com/s/lato/v11/EsvMC5un3kjyUhB9ZEPPwg.woff2" (Just WOFF2)
                ]

  keyframes "buzz-button" $ tuple2 50 (shake id) NEL.:| [tuple2 100 (shake negate)]

  html ? height (pct 100)
  body ? do
    fontFamily ["Lato"] (NEL.singleton sansSerif)
    sym padding nil
    sym margin nil
    backgroundGradient (deg 0)
  (h1 ** a) ? do
    display block
    color blue1
    textDecoration noneTextDecoration
    fontWeight $ weight 100
    sym padding (em 0.5)
  h1 ? do
    fontSize (em 3)
    position absolute
    left (pct 50)
    top (pct 50)
    backgroundGradient (deg 180)
    border solid (px 1) blue1
    sym borderRadius (em 0.25)
  (h1 ## hover) ?
    animation (fromString "buzz-button") (sec 0.15) linear (sec 0) infinite normalAnimationDirection forwards

center :: Number -> Number -> Css
center width height = do
  marginLeft (px $ -width / 2)
  marginTop (px $ -height / 2)

main :: Eff (dom :: DOM) Unit
main = do
  addStyleSheet <<< fromMaybe "" <<< renderedSheet $ render style

  width <- titleWidth
  height <- titleHeight
  titleStyle <<< fromMaybe "" <<< renderedInline <<< render $ center width height

module Site where

import Control.Monad.Eff
import Css.Animation
import Css.Background
import Css.Border
import Css.Color
import Css.Display
import Css.Elements
import Css.Font
import Css.FontFace
import Css.Geometry
import Css.Gradient
import Css.Pseudo
import Css.Render
import Css.Selector
import Css.Size
import Css.String
import Css.Stylesheet
import Css.Text
import Css.Time
import Css.Transform
import Css.Transition
import Data.Maybe
import Data.Tuple.Nested
import DOM
import qualified Data.Array.NonEmpty as NEL

foreign import addStyleSheet """
  function addStyleSheet (s) {
    return function () {
      var e = document.createElement('style');
      e.appendChild(document.createTextNode(s));
      document.head.appendChild(e);
    };
  }
  """ :: String -> Eff (dom :: DOM) Unit

foreign import titleWidth """
  function titleWidth () {
    return document.getElementById('title').offsetWidth;
  }
  """ :: Eff (dom :: DOM) Number

foreign import titleHeight """
  function titleHeight () {
    return document.getElementById('title').offsetHeight;
  }
  """ :: Eff (dom :: DOM) Number

foreign import titleStyle """
  function titleStyle (s) {
    return function () {
      document.getElementById('title').setAttribute('style', s);
    };
  }
  """ :: String -> Eff (dom :: DOM) Unit

blue1 :: Color
blue1 = rgb 51 136 204

blue2 :: Color
blue2 = rgb 238 238 255

backgroundGradient :: forall a. Angle a -> Css
backgroundGradient a = backgroundImage $ linearGradient a (ColorPoint white (pct 0)) [] (ColorPoint blue2 (pct 100))

shakeLeft :: Css
shakeLeft = transforms [translate (px (-3)) nil, rotate (deg (-2))]

shakeRight :: Css
shakeRight = transforms [translate (px 3) nil, rotate (deg 2)]

style :: Css
style = do
  fontFace $ do
    fontFaceFamily $ fromString "Lato"
    fontWeight $ weight 300
    fontFaceSrc $ FontFaceSrcLocal "Lato Light" NEL.:|
                [ FontFaceSrcLocal "Lato-Light"
                , FontFaceSrcUrl "http://fonts.gstatic.com/s/lato/v11/EsvMC5un3kjyUhB9ZEPPwg.woff2" (Just WOFF2)
                ]

  keyframes "buzz-button" $ tuple2 50 shakeRight NEL.:| [tuple2 100 shakeLeft]

  html ? height (pct 100)
  body ? do
    fontFamily ["Lato"] (NEL.singleton sansSerif)
    sym padding nil
    sym margin nil
    backgroundGradient (deg 0)
  (h1 ** a) ? do
    display block
    color blue1
    textDecoration noneTextDecoration
    fontWeight $ weight 100
    sym padding (em 0.5)
  h1 ? do
    fontSize (em 3)
    position absolute
    left (pct 50)
    top (pct 50)
    backgroundGradient (deg 180)
    border solid (px 1) blue1
    sym borderRadius (em 0.25)
  (h1 ## hover) ?
    animation (fromString "buzz-button") (sec 0.15) linear (sec 0) infinite normalAnimationDirection forwards

center :: Number -> Number -> Css
center width height = do
  marginLeft (px $ -width / 2)
  marginTop (px $ -height / 2)

main :: Eff (dom :: DOM) Unit
main = do
  addStyleSheet <<< fromMaybe "" <<< renderedSheet $ render style

  width <- titleWidth
  height <- titleHeight
  titleStyle <<< fromMaybe "" <<< renderedInline <<< render $ center width height


Adding card data

Adding card data

module Cards where

cards =
  {
    "Agent Carr":                  { enabled: true,  faction: "Vydar"   },
    "Airborne Elite":              { enabled: true,  faction: "Jandar"  },
    "Alastair MacDirk":            { enabled: true,  faction: "Jandar"  },
    "Anubian Wolves":              { enabled: true,  faction: "Utgar"   },
    "Aphotia":                     { enabled: true,  faction: "Choobar" },
    "Arkmer":                      { enabled: true,  faction: "Ullar"   },
    "Arrow Gruts":                 { enabled: true,  faction: "Utgar"   },
    "Aubrien Archers":             { enabled: true,  faction: "Ullar"   },
    "Basilisk":                    { enabled: false, faction: "Choobar" },
    "Blade Gruts":                 { enabled: true,  faction: "Utgar"   },
    "Blastatrons":                 { enabled: true,  faction: "Vydar"   },
    "Braxas":                      { enabled: true,  faction: "Vydar"   },
    "Brunak":                      { enabled: true,  faction: "Utgar"   },
    "Chardris":                    { enabled: true,  faction: "Ullar"   },
    "Charos":                      { enabled: true,  faction: "Ullar"   },
    "Concan":                      { enabled: true,  faction: "Jandar"  },
    "Crixus":                      { enabled: true,  faction: "Einar"   },
    "Crucian":                     { enabled: true,  faction: "Choobar" },
    "Deadeye Dan":                 { enabled: true,  faction: "Ullar"   },
    "Deadwood":                    { enabled: true,  faction: "Choobar" },
    "Deathstalkers":               { enabled: true,  faction: "Utgar"   },
    "Deathwalker 7000":            { enabled: true,  faction: "Utgar"   },
    "Deathwalker 8000":            { enabled: true,  faction: "Utgar"   },
    "Deathwalker 9000":            { enabled: true,  faction: "Utgar"   },
    "Dumutef Guard":               { enabled: true,  faction: "Utgar"   },
    "Dund":                        { enabled: true,  faction: "Vydar"   },
    "Elemental Golems":            { enabled: true,  faction: "Vydar"   },
    "Elite Onyx Vipers":           { enabled: true,  faction: "Ullar"   },
    "Emirroon":                    { enabled: true,  faction: "Ullar"   },
    "Festus":                      { enabled: true,  faction: "Jacob"   },
    "Finn":                        { enabled: true,  faction: "Jandar"  },
    "Firefly":                     { enabled: true,  faction: "Ullar"   },
    "Gladiatrons":                 { enabled: true,  faction: "Vydar"   },
    "Gorillinators":               { enabled: true,  faction: "Vydar"   },
    "Grimnak":                     { enabled: true,  faction: "Utgar"   },
    "Grok Riders":                 { enabled: true,  faction: "Utgar"   },
    "Guilty McCreech":             { enabled: true,  faction: "Einar"   },
    "Izumi Samurai":               { enabled: true,  faction: "Einar"   },
    "James Murphy":                { enabled: true,  faction: "Vydar"   },
    "Johnny 'Shotgun' Sullivan":   { enabled: true,  faction: "Jandar"  },
    "Jotun":                       { enabled: true,  faction: "Ullar"   },
    "Kato Katsuro":                { enabled: true,  faction: "Einar"   },
    "Kelda":                       { enabled: true,  faction: "Jandar"  },
    "Kenku Sneak":                 { enabled: true,  faction: "Choobar" },
    "Khosumet":                    { enabled: true,  faction: "Utgar"   },
    "Knights of Weston":           { enabled: true,  faction: "Jandar"  },
    "Kozuke Samurai":              { enabled: true,  faction: "Einar"   },
    "Krav Maga Agents":            { enabled: true,  faction: "Vydar"   },
    "Krug":                        { enabled: true,  faction: "Utgar"   },
    "MacDirk Warriors":            { enabled: true,  faction: "Jandar"  },
    "Major Q10":                   { enabled: true,  faction: "Vydar"   },
    "Major Q9":                    { enabled: true,  faction: "Vydar"   },
    "Major X17":                   { enabled: true,  faction: "Vydar"   },
    "Marcus Decimus":              { enabled: true,  faction: "Einar"   },
    "Marrden Hounds":              { enabled: true,  faction: "Utgar"   },
    "Marrden Nagrubs":             { enabled: true,  faction: "Utgar"   },
    "Marro Drones":                { enabled: true,  faction: "Utgar"   },
    "Marro Drudge":                { enabled: true,  faction: "Utgar"   },
    "Marro Hive":                  { enabled: false, faction: "Utgar"   },
    "Marro Stingers":              { enabled: true,  faction: "Utgar"   },
    "Marro Warriors":              { enabled: true,  faction: "Utgar"   },
    "Me-Burq-Sa":                  { enabled: true,  faction: "Utgar"   },
    "Microcorp Agents":            { enabled: true,  faction: "Vydar"   },
    "Mimring":                     { enabled: true,  faction: "Utgar"   },
    "Minions of Utgar":            { enabled: true,  faction: "Utgar"   },
    "Minutemen":                   { enabled: true,  faction: "Jandar"  },
    "Moriko":                      { enabled: true,  faction: "Ullar"   },
    "Morsbane":                    { enabled: true,  faction: "Ullar"   },
    "Nakita Agents":               { enabled: true,  faction: "Vydar"   },
    "Nathril":                     { enabled: true,  faction: "Jacob"   },
    "Ne-Gok-Sa":                   { enabled: true,  faction: "Utgar"   },
    "Nilfheim":                    { enabled: true,  faction: "Jandar"  },
    "Ninjas of the Northern Wind": { enabled: true,  faction: "Einar"   },
    "Nixy":                        { enabled: true,  faction: "Jacob"   },
    "Obsidian Guards":             { enabled: true,  faction: "Utgar"   },
    "Omnicron Snipers":            { enabled: true,  faction: "Jandar"  },
    "Otonashi":                    { enabled: true,  faction: "Vydar"   },
    "Parmenio":                    { enabled: true,  faction: "Einar"   },
    "Raelin, 1st Edition":         { enabled: true,  faction: "Jandar"  },
    "Raelin, 2nd Edition":         { enabled: true,  faction: "Jandar"  },
    "Rat Bastards":                { enabled: true,  faction: "Utgar"   },
    "Red Coats":                   { enabled: true,  faction: "Einar"   },
    "Retiarius":                   { enabled: true,  faction: "Einar"   },
    "Roman Archers":               { enabled: true,  faction: "Einar"   },
    "Roman Legionnaires":          { enabled: true,  faction: "Einar"   },
    "Sacred Band":                 { enabled: true,  faction: "Einar"   },
    "Saylind":                     { enabled: true,  faction: "Ullar"   },
    "Sentinels of Jandar":         { enabled: true,  faction: "Jandar"  },
    "Sgt. Drake, 1st Edition":     { enabled: true,  faction: "Jandar"  },
    "Sgt. Drake, 2nd Edition":     { enabled: true,  faction: "Jandar"  },
    "Shaolin Monks":               { enabled: true,  faction: "Ullar"   },
    "Shiori":                      { enabled: true,  faction: "Einar"   },
    "Sir Denrick":                 { enabled: true,  faction: "Jandar"  },
    "Sir Dupuis":                  { enabled: true,  faction: "Jandar"  },
    "Sonic Boom":                  { enabled: false, faction: "Choobar" },
    "Sonlen":                      { enabled: true,  faction: "Ullar"   },
    "Spartacus":                   { enabled: true,  faction: "Einar"   },
    "Su-Bak-Na":                   { enabled: true,  faction: "Utgar"   },
    "Sudema":                      { enabled: true,  faction: "Vydar"   },
    "Swog Rider":                  { enabled: true,  faction: "Utgar"   },
    "Syvarris":                    { enabled: true,  faction: "Ullar"   },
    "Taelord":                     { enabled: true,  faction: "Utgar"   },
    "Tagawa Samurai":              { enabled: true,  faction: "Einar"   },
    "Tarn Viking Warriors":        { enabled: true,  faction: "Jandar"  },
    "Templar Cavalry":             { enabled: false, faction: "Jandar"  },
    "Theracus":                    { enabled: true,  faction: "Ullar"   },
    "Thorgrim":                    { enabled: true,  faction: "Jandar"  },
    "Tor-Kul-Na":                  { enabled: false, faction: "Utgar"   },
    "Tornak":                      { enabled: true,  faction: "Utgar"   },
    "Ulginesh":                    { enabled: true,  faction: "Ullar"   },
    "Valguard":                    { enabled: true,  faction: "Einar"   },
    "Venoc Devourers":             { enabled: true,  faction: "Ullar"   },
    "Venoc Vipers":                { enabled: true,  faction: "Ullar"   },
    "Venoc Warlord":               { enabled: true,  faction: "Ullar"   },
    "Veshnir":                     { enabled: true,  faction: "Ullar"   },
    "Warriors of Ashra":           { enabled: true,  faction: "Ullar"   },
    "Wolves of Badru":             { enabled: true,  faction: "Utgar"   },
    "Zettian Guards":              { enabled: true,  faction: "Utgar"   }
  }

error: pathspec 'src/client/js/Cards.purs' did not match any file(s) known to git


Port `Type.Proxy` code from `purescript-proxy`

-- | The `Proxy` type and values are for situations where type information is
-- | required for an input to determine the type of an output, but where it is
-- | not possible or convenient to provide a _value_ for the input.
-- |
-- | A hypothetical example: if you have a class that is used to handle the
-- | result of an AJAX request, you may want to use this information to set the
-- | expected content type of the request, so you might have a class something
-- | like this:
-- |
-- | ``` purescript
-- | class AjaxResponse a where
-- |   responseType :: a -> ResponseType
-- |   fromResponse :: Foreign -> a
-- | ```
-- |
-- | The problem here is `responseType` requires a value of type `a`, but we
-- | won't have a value of that type until the request has been completed. The
-- | solution is to use a `Proxy` type instead:
-- |
-- | ``` purescript
-- | class AjaxResponse a where
-- |   responseType :: Proxy a -> ResponseType
-- |   fromResponse :: Foreign -> a
-- | ```
-- |
-- | We can now call `responseType (Proxy :: Proxy SomeContentType)` to produce
-- | a `ResponseType` for `SomeContentType` without having to construct some
-- | empty version of `SomeContentType` first. In situations like this where
-- | the `Proxy` type can be statically determined, it is recommended to pull
-- | out the definition to the top level and make a declaration like:
-- |
-- | ``` purescript
-- | _SomeContentType :: Proxy SomeContentType
-- | _SomeContentType = Proxy
-- | ```
-- |
-- | That way the proxy value can be used as `responseType _SomeContentType`
-- | for improved readability. However, this is not always possible, sometimes
-- | the type required will be determined by a type variable. As PureScript has
-- | scoped type variables, we can do things like this:
-- |
-- | ``` purescript
-- | makeRequest :: URL -> ResponseType -> Aff _ Foreign
-- | makeRequest = ...
-- |
-- | fetchData :: forall a. (AjaxResponse a) => URL -> Aff _ a
-- | fetchData url = fromResponse <$> makeRequest url (responseType (Proxy :: Proxy a))
-- | ```
module Type.Proxy where

import Prelude

-- | Proxy type for all `kind`s.
data Proxy :: forall k. k -> Type
data Proxy a = Proxy

derive instance eqProxy :: Eq (Proxy a)

derive instance functorProxy :: Functor Proxy

derive instance ordProxy :: Ord (Proxy a)

instance applicativeProxy :: Applicative Proxy where
  pure _ = Proxy

instance applyProxy :: Apply Proxy where
  apply _ _ = Proxy

instance bindProxy :: Bind Proxy where
  bind _ _ = Proxy

instance booleanAlgebraProxy :: BooleanAlgebra (Proxy a)

instance boundedProxy :: Bounded (Proxy a) where
  bottom = Proxy
  top = Proxy

instance commutativeRingProxy :: CommutativeRing (Proxy a)

instance discardProxy :: Discard (Proxy a) where
  discard = bind

instance heytingAlgebraProxy :: HeytingAlgebra (Proxy a) where
  conj _ _ = Proxy
  disj _ _ = Proxy
  implies _ _ = Proxy
  ff = Proxy
  not _ = Proxy
  tt = Proxy

instance monadProxy :: Monad Proxy

instance ringProxy :: Ring (Proxy a) where
  sub _ _ = Proxy

instance semigroupProxy :: Semigroup (Proxy a) where
  append _ _ = Proxy

instance semiringProxy :: Semiring (Proxy a) where
  add _ _ = Proxy
  mul _ _ = Proxy
  one = Proxy
  zero = Proxy

instance showProxy :: Show (Proxy a) where
  show _ = "Proxy"

-- | Value proxy for kind `Type -> Type` types.
-- | **Deprecated as of v0.14.0 PureScript release**: use `Proxy` instead.
data Proxy2 :: (Type -> Type) -> Type
data Proxy2 f = Proxy2

derive instance eqProxy2 :: Eq (Proxy2 a)

derive instance ordProxy2 :: Ord (Proxy2 a)

instance booleanAlgebraProxy2 :: BooleanAlgebra (Proxy2 a)

instance boundedProxy2 :: Bounded (Proxy2 a) where
  bottom = Proxy2
  top = Proxy2

instance commutativeRingProxy2 :: CommutativeRing (Proxy2 a)

instance discardProxy2 :: Discard (Proxy2 a) where
  discard = bind

instance heytingAlgebraProxy2 :: HeytingAlgebra (Proxy2 a) where
  conj _ _ = Proxy2
  disj _ _ = Proxy2
  implies _ _ = Proxy2
  ff = Proxy2
  not _ = Proxy2
  tt = Proxy2

instance ringProxy2 :: Ring (Proxy2 a) where
  sub _ _ = Proxy2

instance semigroupProxy2 :: Semigroup (Proxy2 a) where
  append _ _ = Proxy2

instance semiringProxy2 :: Semiring (Proxy2 a) where
  add _ _ = Proxy2
  mul _ _ = Proxy2
  one = Proxy2
  zero = Proxy2

instance showProxy2 :: Show (Proxy2 a) where
  show _ = "Proxy2"

-- | Value proxy for kind `Type -> Type -> Type` types.
-- | **Deprecated as of v0.14.0 PureScript release**: use `Proxy` instead.
data Proxy3 (a :: Type -> Type -> Type) = Proxy3

derive instance eqProxy3 :: Eq (Proxy3 a)

derive instance ordProxy3 :: Ord (Proxy3 a)

instance booleanAlgebraProxy3 :: BooleanAlgebra (Proxy3 a)

instance boundedProxy3 :: Bounded (Proxy3 a) where
  bottom = Proxy3
  top = Proxy3

instance commutativeRingProxy3 :: CommutativeRing (Proxy3 a)

instance discardProxy3 :: Discard (Proxy3 a) where
  discard = bind

instance heytingAlgebraProxy3 :: HeytingAlgebra (Proxy3 a) where
  conj _ _ = Proxy3
  disj _ _ = Proxy3
  implies _ _ = Proxy3
  ff = Proxy3
  not _ = Proxy3
  tt = Proxy3

instance ringProxy3 :: Ring (Proxy3 a) where
  sub _ _ = Proxy3

instance semigroupProxy3 :: Semigroup (Proxy3 a) where
  append _ _ = Proxy3

instance semiringProxy3 :: Semiring (Proxy3 a) where
  add _ _ = Proxy3
  mul _ _ = Proxy3
  one = Proxy3
  zero = Proxy3

instance showProxy3 :: Show (Proxy3 a) where
  show _ = "Proxy3"

error: pathspec 'src/Type/Proxy.purs' did not match any file(s) known to git


Add TCOCase example.

Add TCOCase example.

module Main where

data Data = One | More Data

main = Debug.Trace.trace (from (to 10000 One))
  where
  to 0 a = a
  to n a = to (n - 1) (More a)
  from One = "Done"
  from (More d) = from d

error: pathspec 'examples/passing/TCOCase.purs' did not match any file(s) known to git


Started work on client wrapper to server

module Gonimo.Server where

import Prelude

import Control.Monad.Aff (runAff)
import Control.Monad.Aff.Console (log)
import qualified Control.Monad.Aff as Aff
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)
import Data.Generic
import Network.HTTP.Affjax
import Data.Foreign.Generic

type FamilyId = Int
type EmailAddress = String

data Invitation = EmailInvitation EmailAddress

derive instance genericInvitation :: Generic Invitation

-- instance isForeignInvitation :: IsForeign Invitation where
--  read = readGeneric defaultOptions

sendInvitation :: forall e . FamilyId -> Invitation -> Affjax e Unit
sendInvitation fid inv = post "http://localhost:8081/1/" (toForeignGeneric inv)

error: pathspec 'src/Gonimo/Server.purs' did not match any file(s) known to git


add Data.CreateSpotResponse

add Data.CreateSpotResponse

module Data.CreateSpotResponse (CreateSpotResponse(..)) where

import Data.Foreign.Class (class IsForeign, readProp)
import Data.Show (class Show, show)
import Prelude (($), (<>), bind, pure)

data CreateSpotResponse = CreateSpotResponse { id :: Int }

instance createSpotResponseShow :: Show CreateSpotResponse where
  show (CreateSpotResponse { id }) = "{ \"id\": " <> show id <> " }"

instance createSpotResponseIsForeign
  :: IsForeign CreateSpotResponse where
  read value = do
    id <- readProp "id" value
    pure $ CreateSpotResponse { id }

error: pathspec 'src/Data/CreateSpotResponse.purs' did not match any file(s) known to git


add doc comment

add doc comment

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/llozovaya/purescript-phantomjs.git/'