module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgs :: Array String -> Maybe (String)
getArgs args = tail args >>= tail >>= head

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (show (getArgs arr)))

Add do notation example and get function

module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgs :: Array String -> Maybe (String)
getArgs args = tail args >>= tail >>= head

getArgsDo :: Array String -> Maybe (String)
getArgsDo args = do
  a <- tail args
  b <- tail a
  head b

get :: Maybe String -> String
get (Just str) = str
get Nothing    = ""

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (get (getArgsDo arr)))


module Test.Main where

import Prelude
import Control.Apply
import Control.Bind

import Control.Monad.Eff.Console
import Control.Monad.Eff.Console.Unsafe

import Data.Posix.Signal (Signal(..))
import Node.Encoding (Encoding(UTF8))
import Node.Buffer as Buffer
import Node.ChildProcess
import Node.Stream (onData)

main = do
  log "spawns processes ok"
  spawnLs

  log "emits an error if executable does not exist"
  nonExistentExecutable $ do
    log "all good."

spawnLs = do
  ls <- spawn "ls" ["-la"] defaultSpawnOptions
  onExit ls \exit ->
      log $ "ls exited: " <> show exit
  onData (stdout ls) (Buffer.toString UTF8 >=> log)

nonExistentExecutable done = do
  ch <- spawn "this-does-not-exist" [] defaultSpawnOptions
  onError ch (\err -> logAny err *> done)

Add test for premature effect performing

module Test.Main where

import Prelude
import Control.Apply
import Control.Bind

import Control.Monad.Eff.Console
import Control.Monad.Eff.Console.Unsafe

import Data.Posix.Signal (Signal(..))
import Node.Encoding (Encoding(UTF8))
import Node.Buffer as Buffer
import Node.ChildProcess
import Node.Stream (onData)

main = do
  log "spawns processes ok"
  spawnLs

  log "emits an error if executable does not exist"
  nonExistentExecutable $ do
    log "all good."

  log "doesn't perform effects too early"
  ls <- spawn "ls" ["-la"] defaultSpawnOptions
  let unused = kill SIGTERM ls
  onExit ls \exit ->
    case exit of
      Normally 0 ->
        log "All good!"
      _ -> do
        log ("Bad exit: expected `Normally 0`, got: " <> show exit)

  log "kills processes"
  ls <- spawn "ls" ["-la"] defaultSpawnOptions
  kill SIGTERM ls
  onExit ls \exit ->
    case exit of
      BySignal SIGTERM ->
        log "All good!"
      _ -> do
        log ("Bad exit: expected `BySignal SIGTERM`, got: " <> show exit)

spawnLs = do
  ls <- spawn "ls" ["-la"] defaultSpawnOptions
  onExit ls \exit ->
      log $ "ls exited: " <> show exit
  onData (stdout ls) (Buffer.toString UTF8 >=> log)

nonExistentExecutable done = do
  ch <- spawn "this-does-not-exist" [] defaultSpawnOptions
  onError ch (\err -> logAny err *> done)


module Main where

import Prelude (Unit, bind, (<>), (>>=))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe (Maybe(..))
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgsBind :: Array String -> Maybe (String)
getArgsBind args = tail args >>= tail >>= head

getArgsDo :: Array String -> Maybe (String)
getArgsDo args = do
  a <- tail args
  b <- tail a
  head b

get :: Maybe String -> String
get (Just str) = str
get Nothing    = ""

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (get (getArgsBind arr)))

Add example for map / bind instead of do-Notation

module Main where

import Prelude (Unit, bind, map, (<>), (>>=))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe (Maybe(..))
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgsBind :: Array String -> Maybe (String)
getArgsBind args = tail args >>= tail >>= head

getArgsDo :: Array String -> Maybe (String)
getArgsDo args = do
  a <- tail args
  b <- tail a
  head b

get :: Maybe String -> String
get (Just str) = str
get Nothing    = ""

-- main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
-- main = do
--   arr <- argv
--   log (greeting (get (getArgsBind arr)))

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = bind (map greeting (map get (map getArgsBind argv))) log


-- | Ungroup groups into their super groups if they only have one branch and all
-- | contained elements are optional.

module Language.Docopt.Solver.Ungroup where

import Prelude
import Data.List (List(), singleton)
import Language.Docopt

unGroup :: Specification -> Specification
unGroup spec = do
  usage <- spec
  pure do
    branch <- usage
    pure do
      arg <- branch
      unGroupArg arg

unGroupArg :: Argument -> List Argument
-- unGroupArg (Group { branches }) =
unGroupArg a = singleton a

Write down initial thoughts on canoicalisation

{-
# Simplify the spec by unnesting groups.

* Singleton groups that contain only a single other group, or "required" groups
  that contain only a single required element. Since the set of "required"
  arguments changes with the 'options.requireFlags' setting, only consider
  positional arguments and commands truely required... As a special case, we
  consider a group compromised entirely of "free" arguments (i.e. options and
  flags) to be "similar enough" to the list of singleton groups, where each
  singleton group is compromised of one component of the original listing.

  Consider:
    * (a)       = a
    * ((a))     = (a) -> a
    * ((a b c)) = (a b c)
    * ([a])     = [a]
    * [([a])]   = [a]
    * [-abc]    = [-a] [-b] [-c]                                  (special case)
    * [-abc -e] = [-a] [-b] [-c] [-e]                             (special case)
    * [-abc -e] = [-a] [-b] [-c] [-e]                             (special case)
    * [-abc  x] = [-abc x]                   (note: no expansion because of 'x')
    * (a...)    = a...
    * (a)...    = a...
    * ((a)...)  = (a)... = a...
    * ((a... b c)...) = ((a... b c)...)    (note: no expansion because of '...')
    * ([a])     = [a]
    * [([a])]   = [a]

  This essentially canonicalises the specification. No meaning is lost in the
  process. At least not in terms of parsing user input against the specification
  later on.
-}

module Language.Docopt.Solver.Ungroup where

import Prelude
import Data.List (List(), singleton)
import Language.Docopt

unGroup :: Specification -> Specification
unGroup spec = do
  usage <- spec
  pure do
    branch <- usage
    pure do
      arg <- branch
      unGroupArg arg

unGroupArg :: Argument -> List Argument
-- unGroupArg (Group { branches }) =
unGroupArg a = singleton a


module Global where

foreign import nan "var nan = NaN;" :: Number

foreign import infinity "var infinity = Infinity;" :: Number

foreign import toExponential
  "function toExponential(n) {\
  \  return n.toExponential();\
  \}" :: Number -> String

foreign import toFixed
  "function toFixed(d) {\
  \  return function(n) {\
  \    return n.toFixed(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import toPrecision
  "function toPrecision(d) {\
  \  return function(n) {\
  \    return n.toPrecision(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import isFinite :: Number -> Boolean

foreign import parseFloat :: String -> Number

foreign import parseInt
  "function parseInt(n) {\
  \  return function(radix) {\
  \    return parseInt(n, radix);\
  \  };\
  \}" :: String -> Number -> Number

foreign import encodeURIComponent :: String -> String

foreign import decodeURIComponent :: String -> String

foreign import encodeURI :: String -> String

foreign import decodeURI :: String -> String

foreign import isNaN :: Number -> Boolean

Remove unsafe stuff and things that belong elsewhere

module Global where

foreign import nan "var nan = NaN;" :: Number

foreign import isNaN :: Number -> Boolean

foreign import infinity "var infinity = Infinity;" :: Number

foreign import isFinite :: Number -> Boolean

foreign import parseInt
  "function parseInt(n) {\
  \  return function(radix) {\
  \    return parseInt(n, radix);\
  \  };\
  \}" :: String -> Number -> Number

foreign import parseFloat :: String -> Number


module DOM.Event.EventTarget where

import Prelude
import Control.Monad.Eff (kind Effect, Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import DOM (DOM)
import DOM.Event.Types (EventTarget, Event, EventType)

-- | A boxed function that can be used as an event listener. This is necessary
-- | due to the underling implementation of Eff functions.
foreign import data EventListener :: # Effect -> Type

-- | Creates an EventListener from a normal PureScript Eff function.
foreign import eventListener
  :: forall eff a
   . (Event -> Eff eff a)
  -> EventListener eff

-- | Adds a listener to an event target. The boolean argument indicates whether
-- | the listener should be added for the "capture" phase.
foreign import addEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Removes a listener to an event target. The boolean argument indicates
-- | whether the listener should be removed for the "capture" phase.
foreign import removeEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Dispatches an event from an event target.
foreign import dispatchEvent
  :: forall eff
   . Event
  -> EventTarget
  -> Eff (dom :: DOM, err :: EXCEPTION | eff) Boolean

Remove DOM effect requirement from event listeners

module DOM.Event.EventTarget where

import Prelude
import Control.Monad.Eff (kind Effect, Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import DOM (DOM)
import DOM.Event.Types (EventTarget, Event, EventType)

-- | A boxed function that can be used as an event listener. This is necessary
-- | due to the underling implementation of Eff functions.
foreign import data EventListener :: # Effect -> Type

-- | Creates an EventListener from a normal PureScript Eff function.
foreign import eventListener
  :: forall eff a
   . (Event -> Eff eff a)
  -> EventListener eff

-- | Adds a listener to an event target. The boolean argument indicates whether
-- | the listener should be added for the "capture" phase.
foreign import addEventListener
  :: forall eff
   . EventType
  -> EventListener eff
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Removes a listener to an event target. The boolean argument indicates
-- | whether the listener should be removed for the "capture" phase.
foreign import removeEventListener
  :: forall eff
   . EventType
  -> EventListener eff
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Dispatches an event from an event target.
foreign import dispatchEvent
  :: forall eff
   . Event
  -> EventTarget
  -> Eff (dom :: DOM, err :: EXCEPTION | eff) Boolean


module Main where

foreign import testError
  "function testError(f) {\
  \  try {\
  \    return f();\
  \  } catch (e) {\
  \    if (e instanceof Error) return 'success';\
  \    throw new Error('Pattern match failure is not TypeError');\
  \  }\
  \}" :: (Unit -> Number) -> Number

fn :: Number -> Number
fn 0 = 0
fn 1 = 2

main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)

Tweak test error message and type

module Main where

foreign import testError
  "function testError(f) {\
  \  try {\
  \    return f();\
  \  } catch (e) {\
  \    if (e instanceof Error) return 'success';\
  \    throw new Error('Pattern match failure is not Error');\
  \  }\
  \}" :: (Unit -> Number) -> String

fn :: Number -> Number
fn 0 = 0
fn 1 = 2

main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)


module Web.Firebase.UnsafeRef
  ( refFor
  ) where

import Control.Monad.Aff (Aff())
import Control.Monad.Eff.Class (liftEff)
import Data.Either.Unsafe  (fromRight)
import Data.URI (runParseURI)
import Web.Firebase as FB
import Web.Firebase.Types as FBT

-- | Unsafely read a string that might be a reference, and turn it into a firebase reference
-- may throw javascript exceptions, intended to keep test code terse, not meant for production usage
-- only pass constants to this
refFor :: String -> forall eff. Aff (firebase :: FBT.FirebaseEff | eff) FBT.Firebase
refFor s = do
  let fbUri = fromRight (runParseURI s)
  liftEff (FB.newFirebase fbUri)

Add Eff variant of unsafeRef

module Web.Firebase.UnsafeRef
  ( refFor,
    unsafeRef
  ) where
import Prelude (($))
import Control.Monad.Aff (Aff())
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Class (liftEff)
import Data.Either.Unsafe  (fromRight)
import Data.URI (runParseURI)
import Web.Firebase as FB
import Web.Firebase.Types as FBT

--| Aff version of unsafeRef
refFor :: String -> forall eff. Aff (firebase :: FBT.FirebaseEff | eff) FBT.Firebase
refFor s = liftEff (unsafeRef s)

-- | Unsafely read a string that might be a reference, and turn it into a firebase reference
-- may throw javascript exceptions, intended to keep test code terse, not meant for production usage
-- This will fail silently if you pass something that is not a url.
unsafeRef :: String -> forall eff. Eff (firebase :: FBT.FirebaseEff | eff) FBT.Firebase
unsafeRef s = FB.newFirebase $ fromRight (runParseURI s)


module Main where

import Data.Traversable (for)

import Control.Monad.Eff
import Control.Monad.Eff.DOM
import Control.Monad.Eff.Ref

import Graphics.Canvas

import Debug.Trace

render :: forall eff. Number -> Context2D -> Eff (canvas :: Canvas | eff) Context2D
render count ctx = do
  setFillStyle "#FFFFFF" ctx

  fillPath ctx $ rect ctx
    { x: 0
    , y: 0
    , w: 600
    , h: 600
    }

  setFillStyle "#00FF00" ctx

  withContext ctx $ do
    let newScale = Math.sin (count * Math.pi / 4) + 1.5

    translate { translateX:  300, translateY:  300 } ctx
    rotate (count * Math.pi / 18) ctx
    scale { scaleX: newScale, scaleY: newScale } ctx
    translate { translateX: -100, translateY: -100 } ctx

    fillPath ctx $ rect ctx
      { x: 0
      , y: 0
      , w: 200
      , h: 200
      }

main = do
  canvas <- getCanvasElementById "canvas"
  ctx <- getContext2D canvas

  clickCount <- newRef 0

  render 0 ctx

  node <- querySelector "#canvas"
  for node $ addEventListener "click" $ do
    trace "Mouse clicked!"

    modifyRef clickCount (\count -> count + 1)

    count <- readRef clickCount

    render count ctx

    return unit

Scale x and y independently

module Main where

import Data.Traversable (for)

import Control.Monad.Eff
import Control.Monad.Eff.DOM
import Control.Monad.Eff.Ref

import Graphics.Canvas

import Debug.Trace

render :: forall eff. Number -> Context2D -> Eff (canvas :: Canvas | eff) Context2D
render count ctx = do
  setFillStyle "#FFFFFF" ctx

  fillPath ctx $ rect ctx
    { x: 0
    , y: 0
    , w: 600
    , h: 600
    }

  setFillStyle "#00FF00" ctx

  withContext ctx $ do
    let scaleX = Math.sin (count * Math.pi / 4) + 1.5
    let scaleY = Math.sin (count * Math.pi / 6) + 1.5

    translate { translateX:  300, translateY:  300 } ctx
    rotate (count * Math.pi / 18) ctx
    scale { scaleX: scaleX, scaleY: scaleY } ctx
    translate { translateX: -100, translateY: -100 } ctx

    fillPath ctx $ rect ctx
      { x: 0
      , y: 0
      , w: 200
      , h: 200
      }

main = do
  canvas <- getCanvasElementById "canvas"
  ctx <- getContext2D canvas

  clickCount <- newRef 0

  render 0 ctx

  node <- querySelector "#canvas"
  for node $ addEventListener "click" $ do
    trace "Mouse clicked!"

    modifyRef clickCount (\count -> count + 1)

    count <- readRef clickCount

    render count ctx

    return unit


module Data.Symbol
  ( class IsSymbol
  , reflectSymbol
  , reifySymbol
  , SProxy(..)
  ) where

import Type.Proxy (Proxy(..))

-- | A value-level proxy for a type-level symbol.
data SProxy (sym :: Symbol) = SProxy

-- | A class for known symbols
class IsSymbol (sym :: Symbol) where
  reflectSymbol :: Proxy sym -> String

-- local definition for use in `reifySymbol`
foreign import unsafeCoerce :: forall a b. a -> b

reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r
reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy where
  coerce
    :: (forall sym1. IsSymbol sym1              => Proxy sym1 -> r)
    -> { reflectSymbol :: Proxy "" -> String } -> Proxy ""   -> r
  coerce = unsafeCoerce

Use `forall proxy. proxy sym` to make current SProxy code still compile

module Data.Symbol
  ( class IsSymbol
  , reflectSymbol
  , reifySymbol
  , SProxy(..)
  ) where

import Type.Proxy (Proxy(..))

-- | A value-level proxy for a type-level symbol.
data SProxy (sym :: Symbol) = SProxy

-- | A class for known symbols
class IsSymbol (sym :: Symbol) where
  reflectSymbol :: forall proxy. proxy sym -> String

-- local definition for use in `reifySymbol`
foreign import unsafeCoerce :: forall a b. a -> b

reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r
reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy where
  coerce
    :: (forall sym1. IsSymbol sym1              => Proxy sym1 -> r)
    -> { reflectSymbol :: Proxy "" -> String } -> Proxy ""   -> r
  coerce = unsafeCoerce


module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate caching that takes place within mustache.js.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and store parsed token in mustache.js's cache.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit

Clarify what effect means in docs

module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate writes that take place to mustache.js's cache.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and store parsed token in mustache.js's cache.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit


module DOM.File.Types where

import DOM.Event.Types (EventTarget)
import Unsafe.Coerce (unsafeCoerce)

foreign import data Blob :: *
foreign import data BlobURL :: *
foreign import data File :: *
foreign import data FileList :: *
foreign import data FileReader :: *
foreign import data FileReaderSync :: *

fileToBlob :: File -> Blob
fileToBlob = unsafeCoerce

fileReaderToEventTarget :: FileReader -> EventTarget
fileReaderToEventTarget = unsafeCoerce

Add IsForeign instance for FileList

module DOM.File.Types where

import DOM.Event.Types (EventTarget)
import Data.Foreign (Foreign, F, unsafeReadTagged)
import Data.Foreign.Class (class IsForeign)
import Unsafe.Coerce (unsafeCoerce)

foreign import data Blob :: *
foreign import data BlobURL :: *
foreign import data File :: *
foreign import data FileList :: *
foreign import data FileReader :: *
foreign import data FileReaderSync :: *

fileToBlob :: File -> Blob
fileToBlob = unsafeCoerce

fileReaderToEventTarget :: FileReader -> EventTarget
fileReaderToEventTarget = unsafeCoerce

readFileList :: Foreign -> F FileList
readFileList = unsafeReadTagged "FileList"

instance isForeignFileList :: IsForeign FileList where
  read = readFileList


module Tab
  ( Cell
  , Col
  , class ColType
  , kind
  , Tab
  ) where

import Prelude
import Data.Maybe (Maybe(..))
import Data.Vec
import Data.List
import Data.Typelevel.Num

type Col x = ColType x =>
  { id :: Int
  , name :: String
  , kind :: x
  }

class ColType a where
  kind :: a

instance stringCol :: ColType String where
  kind = ""

type Cell a = Maybe a

class Conv a where
  conv :: ColType a => a -> Cell a

instance convAny :: Conv a where
  conv x = Just x

newtype Tab size cols cells = Table
  { columns :: Vec size cols
  , rows :: List (Vec size cells)
  }

Add empty method, needs correct type

module Tab
  ( Cell
  , Col
  , class ColType
  , kind
  , Tab
  ) where

import Prelude
import Data.Maybe (Maybe(..))
import Data.Vec
import Data.Vec (empty) as Vec
import Data.List
import Data.Typelevel.Num

type Col x = ColType x =>
  { id :: Int
  , name :: String
  , kind :: x
  }

class ColType a where
  kind :: a

instance stringCol :: ColType String where
  kind = ""

type Cell a = Maybe a

class Conv a where
  conv :: ColType a => a -> Cell a

instance convAny :: Conv a where
  conv x = Just x

newtype Tab size cols cells = Table
  { columns :: Vec size cols
  , rows :: List (Vec size cells)
  }

empty :: Tab D0 (Vec D0) List
empty = Tab
  { columns : Vec.empty
  , rows : Nil
  }


module Control.Alt where

infixl 3 <|>

-- | The `Alt` type class identifies an associative operation on a type.
-- | It is similar to `Semigroup`, except that it applies to types of
-- | kind (* -> *), like Array or List, rather than concrete types like
-- | String or Number.
-- |
-- | `Alt` instances are required to satisfy the following law:
-- |
-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)`
-- |
-- | For example, the `Array` (`[]`) type is an instance of `Alt`, where
-- | (<|>) is defined to be concatenation.
class (Functor f) <= Alt f where
  (<|>) :: forall a. f a -> f a -> f a

Make all (<|>) go in <code> tags

module Control.Alt where

infixl 3 <|>

-- | The `Alt` type class identifies an associative operation on a type.
-- | It is similar to `Semigroup`, except that it applies to types of
-- | kind (* -> *), like Array or List, rather than concrete types like
-- | String or Number.
-- |
-- | `Alt` instances are required to satisfy the following law:
-- |
-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)`
-- |
-- | For example, the `Array` (`[]`) type is an instance of `Alt`, where
-- | `(<|>)` is defined to be concatenation.
class (Functor f) <= Alt f where
  (<|>) :: forall a. f a -> f a -> f a


module Data.Void (Void, absurd) where

import Data.Show (class Show)

-- | An uninhabited data type. In other words, one can never create
-- | a runtime value of type `Void` becaue no such value exists.
-- |
-- | `Void` is useful to eliminate the possibility of a value being created.
-- | For example, a value of type `Either Void Boolean` can never have
-- | a Left value created in PureScript.
-- |
-- | This should not be confused with the keyword `void` that commonly appears in
-- | C-family languages, such as Java:
-- | ```
-- | public class Foo {
-- |   void doSomething() { System.out.println("hello world!"); }
-- | }
-- | ```
-- |
-- | In PureScript, one often uses `Unit` to achieve similar effects as
-- | the lowercased `void` above.
newtype Void = Void Void

instance showVoid :: Show Void where
  show = absurd

-- | Eliminator for the `Void` type.
-- | Useful for stating that some code branch is impossible because you've
-- | "acquired" a value of type `Void` (which you can't).
-- |
-- | ```purescript
-- | rightOnly :: forall t . Either Void t -> t
-- | rightOnly (Left v) = absurd v
-- | rightOnly (Right t) = t
-- | ```
absurd :: forall a. Void -> a
absurd a = spin a
  where
  spin (Void b) = spin b

Use 'void of C-family languages' rendering

module Data.Void (Void, absurd) where

import Data.Show (class Show)

-- | An uninhabited data type. In other words, one can never create
-- | a runtime value of type `Void` becaue no such value exists.
-- |
-- | `Void` is useful to eliminate the possibility of a value being created.
-- | For example, a value of type `Either Void Boolean` can never have
-- | a Left value created in PureScript.
-- |
-- | This should not be confused with the keyword `void` that commonly appears in
-- | C-family languages, such as Java:
-- | ```
-- | public class Foo {
-- |   void doSomething() { System.out.println("hello world!"); }
-- | }
-- | ```
-- |
-- | In PureScript, one often uses `Unit` to achieve similar effects as
-- | the `void` of C-family languages above.
newtype Void = Void Void

instance showVoid :: Show Void where
  show = absurd

-- | Eliminator for the `Void` type.
-- | Useful for stating that some code branch is impossible because you've
-- | "acquired" a value of type `Void` (which you can't).
-- |
-- | ```purescript
-- | rightOnly :: forall t . Either Void t -> t
-- | rightOnly (Left v) = absurd v
-- | rightOnly (Right t) = t
-- | ```
absurd :: forall a. Void -> a
absurd a = spin a
  where
  spin (Void b) = spin b


module Genetics.Browser.Config.Track
       where

import Prelude
import Data.Foreign (Foreign, toForeign)

newtype BDTrackConfig = BDTrackConfig Foreign

makeBDTrack :: ∀ r. { name :: String | r } -> BDTrackConfig
makeBDTrack = (BDTrackConfig <<< toForeign)

Add (very basic) BD track config validation

module Genetics.Browser.Config.Track
       where

import Prelude
import Data.Argonaut (Json, _Object)
import Data.Either (Either(..))
import Data.Foreign (Foreign, toForeign)
import Data.Lens ((^?))
import Data.Lens.Index (ix)
import Data.Maybe (Maybe(..))

-- TODO add some BD validation
newtype BDTrackConfig = BDTrackConfig Foreign

makeBDTrack :: ∀ r. { name :: String | r } -> BDTrackConfig
makeBDTrack = (BDTrackConfig <<< toForeign)

validateBDConfig :: Json -> Either String BDTrackConfig
validateBDConfig json = case json ^? _Object <<< ix "name" of
  Nothing -> Left $ "BD track config does not have a name"
  Just c  -> Right $ BDTrackConfig $ toForeign json


module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array

foreign import process :: forall props. { | props }

main :: Array String -> forall e. Eff (console :: CONSOLE | e) Unit
main input = do
  log "Hello " <> (show (head input)) <> "!"

Make main as in 01

module Main where

import Prelude
import Data.Array

greeting :: Array String -> String
greeting arr = "Hello " <> (show (head arr)) <> "!"

main :: Array String -> String
main arr = greeting arr


module Control.Monad.State.Trans where

import Prelude
import Control.Monad.Trans

type StateData s a = { state :: s, value :: a }

data StateT s m a = StateT (s -> m (StateData s a))

instance monadStateT :: (Monad m) => Monad (StateT s m) where
  return a = StateT \s -> return { state: s, value: a }
  (>>=) (StateT x) f = StateT \s -> do
    { state = s', value = v } <- x s
    runStateT (f v) s'

instance monadTransStateT :: MonadTrans (StateT s) where
  lift m = StateT \s -> do
    x <- m
    return { state: s, value: x }

runStateT :: forall s m a. StateT s m a -> s -> m (StateData s a)
runStateT (StateT s) = s

withStateT :: forall s m a. (s -> s) -> StateT s m a -> StateT s m a
withStateT f s = StateT $ runStateT s <<< f

Add additional state running functions

module Control.Monad.State.Trans where

import Prelude
import Control.Monad.Trans

type StateData s a = { state :: s, value :: a }

data StateT s m a = StateT (s -> m (StateData s a))

instance monadStateT :: (Monad m) => Monad (StateT s m) where
  return a = StateT \s -> return { state: s, value: a }
  (>>=) (StateT x) f = StateT \s -> do
    { state = s', value = v } <- x s
    runStateT (f v) s'

instance monadTransStateT :: MonadTrans (StateT s) where
  lift m = StateT \s -> do
    x <- m
    return { state: s, value: x }

runStateT :: forall s m a. StateT s m a -> s -> m (StateData s a)
runStateT (StateT s) = s

evalStateT :: forall s m a. (Monad m) => StateT s m a -> s -> m a
evalStateT m s = runStateT m s >>= \x -> return x.value

execStateT :: forall s m a. (Monad m) => StateT s m a -> s -> m s
execStateT m s = runStateT m s >>= \x -> return x.state

mapStateT :: forall s m1 m2 a b. (m1 (StateData s a) -> m2 (StateData s b)) -> StateT s m1 a -> StateT s m2 b
mapStateT f m = StateT $ f <<< runStateT m

withStateT :: forall s m a. (s -> s) -> StateT s m a -> StateT s m a
withStateT f s = StateT $ runStateT s <<< f


module Data.Char.Gen where

import Prelude

import Control.Monad.Gen (class MonadGen, chooseInt, oneOf)
import Data.Char as C
import Data.NonEmpty ((:|))

-- | Generates a character of the Unicode basic multilingual plain.
genUnicodeChar :: forall m. MonadGen m => m Char
genUnicodeChar = C.fromCharCode <$> chooseInt 0 65536

-- | Generates a character in the ASCII character set, excluding control codes.
genAsciiChar :: forall m. MonadGen m => m Char
genAsciiChar = C.fromCharCode <$> chooseInt 32 127

-- | Generates a character in the ASCII character set.
genAsciiChar' :: forall m. MonadGen m => m Char
genAsciiChar' = C.fromCharCode <$> chooseInt 0 127

-- | Generates a character that is a numeric digit.
genDigitChar :: forall m. MonadGen m => m Char
genDigitChar = C.fromCharCode <$> chooseInt 48 57

-- | Generates a character from the basic latin alphabet.
genAlpha :: forall m. MonadGen m => m Char
genAlpha = oneOf (genAlphaLowercase :| [genAlphaUppercase])

-- | Generates a lowercase character from the basic latin alphabet.
genAlphaLowercase :: forall m. MonadGen m => m Char
genAlphaLowercase = C.fromCharCode <$> chooseInt 97 122

-- | Generates an uppercase character from the basic latin alphabet.
genAlphaUppercase :: forall m. MonadGen m => m Char
genAlphaUppercase = C.fromCharCode <$> chooseInt 65 90

Fix typo: 'plain' -> 'plane'

module Data.Char.Gen where

import Prelude

import Control.Monad.Gen (class MonadGen, chooseInt, oneOf)
import Data.Char as C
import Data.NonEmpty ((:|))

-- | Generates a character of the Unicode basic multilingual plane.
genUnicodeChar :: forall m. MonadGen m => m Char
genUnicodeChar = C.fromCharCode <$> chooseInt 0 65536

-- | Generates a character in the ASCII character set, excluding control codes.
genAsciiChar :: forall m. MonadGen m => m Char
genAsciiChar = C.fromCharCode <$> chooseInt 32 127

-- | Generates a character in the ASCII character set.
genAsciiChar' :: forall m. MonadGen m => m Char
genAsciiChar' = C.fromCharCode <$> chooseInt 0 127

-- | Generates a character that is a numeric digit.
genDigitChar :: forall m. MonadGen m => m Char
genDigitChar = C.fromCharCode <$> chooseInt 48 57

-- | Generates a character from the basic latin alphabet.
genAlpha :: forall m. MonadGen m => m Char
genAlpha = oneOf (genAlphaLowercase :| [genAlphaUppercase])

-- | Generates a lowercase character from the basic latin alphabet.
genAlphaLowercase :: forall m. MonadGen m => m Char
genAlphaLowercase = C.fromCharCode <$> chooseInt 97 122

-- | Generates an uppercase character from the basic latin alphabet.
genAlphaUppercase :: forall m. MonadGen m => m Char
genAlphaUppercase = C.fromCharCode <$> chooseInt 65 90


{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module Utils.CSS where

import Prelude
import CSS (CSS)
import CSS.String (fromString)
import CSS.Stylesheet (key)

transition :: String -> CSS
transition = key (fromString "transition")

calc :: String -> String
calc s = "calc(" <> s <> ")"

width :: String -> CSS
width = key (fromString "width")

left :: String -> CSS
left = key (fromString "left")

marginLeft :: String -> CSS
marginLeft = key (fromString "margin-left")

transform :: String -> CSS
transform = key (fromString "transform")

translate3d :: String -> String -> String -> String
translate3d x y z = "translate3d(" <> x <> "," <> y <> "," <> z <> ")"

zIndex :: Int → CSS
zIndex = key (fromString "z-index") <<< show

Remove marginLeft from DOM utils

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module Utils.CSS where

import Prelude
import CSS (CSS)
import CSS.String (fromString)
import CSS.Stylesheet (key)

transition :: String -> CSS
transition = key (fromString "transition")

calc :: String -> String
calc s = "calc(" <> s <> ")"

width :: String -> CSS
width = key (fromString "width")

left :: String -> CSS
left = key (fromString "left")

transform :: String -> CSS
transform = key (fromString "transform")

translate3d :: String -> String -> String -> String
translate3d x y z = "translate3d(" <> x <> "," <> y <> "," <> z <> ")"

zIndex :: Int → CSS
zIndex = key (fromString "z-index") <<< show


module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate writes that take place to mustache.js's cache.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and store parsed token in mustache.js's cache.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit

Include reads as well as writes to mustache.js's cache in docs

module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate interactions with the cache in mustache.js.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and store parsed token in mustache.js's cache.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit


module ThirdTab
  ( class ColT
  ) where

import Data.List

class ColT a

type Cells a = List a

newtype ThirdTab colTypes = ThirdTab
  { cols :: List colTypes
  , rows :: List (Cells colTypes)
  }

empty :: forall a. ColT a => ThirdTab a
empty = ThirdTab
  { cols : Nil
  , rows : Nil
  }

addColumn :: forall a. ColT a => Int -> String -> ThirdTab a -> ThirdTab a
addColumn id name (ThirdTab table) = ThirdTab { cols: table.cols, rows: table.rows }

Define some types for third try

module ThirdTab
  ( class ColT
  ) where

import Data.List

class ColT a

type Cells a = ColT a => List a

newtype Col a = Col { id :: Int, name :: String }

newtype ThirdTab colTypes = ThirdTab
  { cols :: List colTypes
  , rows :: List (Cells colTypes)
  }

empty :: forall a. ColT a => ThirdTab a
empty = ThirdTab
  { cols : Nil
  , rows : Nil
  }

addColumn :: forall a. ColT a => Int -> String -> ThirdTab a -> ThirdTab _
addColumn id name (ThirdTab table) = ThirdTab { cols: table.cols, rows: Nil }


module Components.Expressions
  ( component
  ) where

import Lambda.Prelude

import Lambda.Language.PrettyPrint (Rep, Doc, selectRep)
import React.Basic (JSX)
import React.Basic.DOM as R

type Props =
  { history :: Array (Doc String)
  , rep :: Rep
  }

component :: Props -> JSX
component {history, rep} =
  R.ul
    { className: "unstyled scroll-overflow"
    , children: map renderExpr history
    }
 where
  renderExpr expr =
    R.li
      { className: "expression"
      , children: [R.text $ selectRep expr rep]
      }

Truncate history to 20 expressions when rendering

module Components.Expressions
  ( component
  ) where

import Lambda.Prelude

import Data.Array as Array
import Lambda.Language.PrettyPrint (Rep, Doc, withRep)
import React.Basic (JSX)
import React.Basic.DOM as R

type Props =
  { history :: List (Doc String)
  , rep :: Rep
  }

component :: Props -> JSX
component {history, rep} = R.ul
  { className: "unstyled scroll-overflow"
  , children: truncate rep history
  }

truncate :: Rep -> List (Doc String) -> Array JSX
truncate rep = Array.fromFoldable <<< loop 20
 where
  loop :: Int -> List (Doc String) -> List JSX
  loop n = case _ of
    Nil -> Nil
    Cons t ts
      | n <= 0 -> item "…" : Nil
      | otherwise -> item (withRep rep t) : loop (n - 1) ts

  item :: String -> JSX
  item t = R.li
    { className: "expression"
    , children: [R.text t]
    }


module Config where

uploadUrl :: String
uploadUrl = "/upload"

metadataUrl :: String
metadataUrl = "/metadata/fs/"

dataUrl :: String
dataUrl = "/data/fs/"

notebookUrl :: String
notebookUrl = "/notebook.html"

searchTimeout :: Number
searchTimeout = 500

slamDataHome :: String
slamDataHome = "http://slamdata.com"

userEnabled :: Boolean
userEnabled = false

newFolderName :: String
newFolderName = "Untitled Folder"

notebookExtension :: String
notebookExtension = ".slam"

newNotebookName :: String
newNotebookName = "Untitled Notebook" <> notebookExtension

homeHash :: String
homeHash = "#?sort=asc&q=path%3A%2F&salt="

Change logo link to /

module Config where

uploadUrl :: String
uploadUrl = "/upload"

metadataUrl :: String
metadataUrl = "/metadata/fs/"

dataUrl :: String
dataUrl = "/data/fs/"

notebookUrl :: String
notebookUrl = "/notebook.html"

searchTimeout :: Number
searchTimeout = 500

slamDataHome :: String
slamDataHome = "/"

userEnabled :: Boolean
userEnabled = false

newFolderName :: String
newFolderName = "Untitled Folder"

notebookExtension :: String
notebookExtension = ".slam"

newNotebookName :: String
newNotebookName = "Untitled Notebook" <> notebookExtension

homeHash :: String
homeHash = "#?sort=asc&q=path%3A%2F&salt="


module DOM.Event.EventTarget where

import Prelude
import Control.Monad.Eff (kind Effect, Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import DOM (DOM)
import DOM.Event.Types (EventTarget, Event, EventType)

-- | A boxed function that can be used as an event listener. This is necessary
-- | due to the underling implementation of Eff functions.
foreign import data EventListener :: # Effect -> Type

-- | Creates an EventListener from a normal PureScript Eff function.
foreign import eventListener
  :: forall eff a
   . (Event -> Eff eff a)
  -> EventListener eff

-- | Adds a listener to an event target. The boolean argument indicates whether
-- | the listener should be added for the "capture" phase.
foreign import addEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Removes a listener to an event target. The boolean argument indicates
-- | whether the listener should be removed for the "capture" phase.
foreign import removeEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Dispatches an event from an event target.
foreign import dispatchEvent
  :: forall eff
   . Event
  -> EventTarget
  -> Eff (dom :: DOM, err :: EXCEPTION | eff) Boolean

Fix minor typo: underling --> underlying

module DOM.Event.EventTarget where

import Prelude
import Control.Monad.Eff (kind Effect, Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import DOM (DOM)
import DOM.Event.Types (EventTarget, Event, EventType)

-- | A boxed function that can be used as an event listener. This is necessary
-- | due to the underlying implementation of Eff functions.
foreign import data EventListener :: # Effect -> Type

-- | Creates an EventListener from a normal PureScript Eff function.
foreign import eventListener
  :: forall eff a
   . (Event -> Eff eff a)
  -> EventListener eff

-- | Adds a listener to an event target. The boolean argument indicates whether
-- | the listener should be added for the "capture" phase.
foreign import addEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Removes a listener to an event target. The boolean argument indicates
-- | whether the listener should be removed for the "capture" phase.
foreign import removeEventListener
  :: forall eff
   . EventType
  -> EventListener (dom :: DOM | eff)
  -> Boolean
  -> EventTarget
  -> Eff (dom :: DOM | eff) Unit

-- | Dispatches an event from an event target.
foreign import dispatchEvent
  :: forall eff
   . Event
  -> EventTarget
  -> Eff (dom :: DOM, err :: EXCEPTION | eff) Boolean


module Main where

import Control.Monad.Aff
import Test.Spec (describe, pending, it)
import Test.Spec.Node
import Test.Spec.Assertions
import Test.Spec.Reporter.Console
import Test.QuickCheck

main = runNode [consoleReporter] do
  describe "purescript-spec" do
    describe "What is it?" do
      it "awesome" do
        let isAwesome = true
        isAwesome `shouldEqual` true
    describe "Features" do
      it "run specs in NodeJS" $ return unit
      it "supports async specs" do
        res <- later' 100 $ return "Alligator"
        res `shouldEqual` "Alligator"
    describe "TODO" do
      pending "browser support!"

Modify example to work with psc 0.7

module Main where

import Prelude

import Control.Monad.Aff
import Test.Spec (describe, pending, it)
import Test.Spec.Node
import Test.Spec.Assertions
import Test.Spec.Reporter.Console

main = runNode [consoleReporter] do
  describe "purescript-spec" do
    describe "What is it?" do
      it "awesome" do
        let isAwesome = true
        isAwesome `shouldEqual` true
    describe "Features" do
      it "run specs in NodeJS" $ return unit
      it "supports async specs" do
        res <- later' 100 $ return "Alligator"
        res `shouldEqual` "Alligator"
      it "supports PureScript 0.7" $ return unit
    describe "TODO" do
      pending "browser support!"


module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head)
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (show (head arr)))

Use bind operator (>>=) to get head of tail of tail

module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgs :: Array String -> Maybe (String)
getArgs args = tail args >>= tail >>= head

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (show (getArgs arr)))


module Components.Input
  ( component
  ) where

import Lambda.Prelude

import React.Basic (JSX)
import React.Basic.DOM as R
import React.Basic.DOM.Events (targetValue, preventDefault)
import React.Basic.Events (handler, handler_)

type Props =
  { text :: String
  , onChange :: String -> Effect Unit
  , onSubmit :: Effect Unit
  , onHelp :: Effect Unit
  }

component :: Props -> JSX
component {text, onChange, onSubmit, onHelp} =
  R.form
    { onSubmit: handler preventDefault $ const onSubmit
    , children:
      [ inputGroup
        [ inputGroupBtn $ R.button
          { className: "btn btn-info"
          , "type": "button"
          , onClick: handler_ onHelp
          , children: [R.text "Help"]
          }
        , R.input
          { className: "form-control monospace-font"
          , placeholder: "expression or definition"
          , onChange: handler targetValue $ traverse_ onChange
          , value: text
          }
        , inputGroupBtn $ R.button
          { className: "btn btn-default"
          , "type": "submit"
          , onClick: handler_ onSubmit
          , children: [R.text "Parse"]
          }
        ]
      ]
    }

inputGroup :: Array JSX -> JSX
inputGroup children =
  R.div
    { className: "input-group"
    , children
    }

inputGroupBtn :: JSX -> JSX
inputGroupBtn child =
  R.div
    { className: "input-group-btn"
    , children: [child]
    }

Remove autocorrect/capitalization/complete and spellcheck from input

module Components.Input
  ( component
  ) where

import Lambda.Prelude

import React.Basic (JSX)
import React.Basic.DOM as R
import React.Basic.DOM.Events (targetValue, preventDefault)
import React.Basic.Events (handler, handler_)

type Props =
  { text :: String
  , onChange :: String -> Effect Unit
  , onSubmit :: Effect Unit
  , onHelp :: Effect Unit
  }

component :: Props -> JSX
component {text, onChange, onSubmit, onHelp} =
  R.form
    { onSubmit: handler preventDefault $ const onSubmit
    , children:
      [ inputGroup
        [ inputGroupBtn $ R.button
          { className: "btn btn-info"
          , "type": "button"
          , onClick: handler_ onHelp
          , children: [R.text "Help"]
          }
        , R.input
          { className: "form-control monospace-font"
          , autoComplete: "off"
          , autoCorrect: "off"
          , autoCapitalize: "off"
          , spellCheck: false
          , placeholder: "expression or definition"
          , onChange: handler targetValue $ traverse_ onChange
          , value: text
          }
        , inputGroupBtn $ R.button
          { className: "btn btn-default"
          , "type": "submit"
          , onClick: handler_ onSubmit
          , children: [R.text "Parse"]
          }
        ]
      ]
    }

inputGroup :: Array JSX -> JSX
inputGroup children =
  R.div
    { className: "input-group"
    , children
    }

inputGroupBtn :: JSX -> JSX
inputGroupBtn child =
  R.div
    { className: "input-group-btn"
    , children: [child]
    }


module Data.Symbol
  ( class IsSymbol
  , reflectSymbol
  , reifySymbol
  , SProxy(..)
  ) where

import Type.Proxy (Proxy(..))

-- | A value-level proxy for a type-level symbol.
data SProxy (sym :: Symbol) = SProxy

-- | A class for known symbols
class IsSymbol (sym :: Symbol) where
  reflectSymbol :: forall proxy. proxy sym -> String

-- local definition for use in `reifySymbol`
foreign import unsafeCoerce :: forall a b. a -> b

reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r
reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy where
  coerce
    :: (forall sym1. IsSymbol sym1              => Proxy sym1 -> r)
    -> { reflectSymbol :: Proxy "" -> String } -> Proxy ""   -> r
  coerce = unsafeCoerce

Add notice of SProxy deprecation

module Data.Symbol
  ( class IsSymbol
  , reflectSymbol
  , reifySymbol
  , SProxy(..)
  ) where

import Type.Proxy (Proxy(..))

-- | A value-level proxy for a type-level symbol.
-- | **Deprecated as of v0.14.0 PureScript release**: use `Type.Proxy` instead.
data SProxy (sym :: Symbol) = SProxy

-- | A class for known symbols
class IsSymbol (sym :: Symbol) where
  reflectSymbol :: forall proxy. proxy sym -> String

-- local definition for use in `reifySymbol`
foreign import unsafeCoerce :: forall a b. a -> b

reifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r
reifySymbol s f = coerce f { reflectSymbol: \_ -> s } Proxy where
  coerce
    :: (forall sym1. IsSymbol sym1              => Proxy sym1 -> r)
    -> { reflectSymbol :: Proxy "" -> String } -> Proxy ""   -> r
  coerce = unsafeCoerce


module Genetics.Browser.Config
       where

import Prelude
import Data.Array (null)
import Data.Foldable (all)
import Data.Foreign (F, Foreign, ForeignError(..), fail, unsafeReadTagged)
import Data.Foreign.Index ((!))
import Data.Foreign.Keys (keys)
import Data.Maybe (isJust)
import Genetics.Browser.Biodalliance (BrowserConstructor, RenderWrapper)
import Genetics.Browser.Config.Track (TracksMap, readTrackType)
import Unsafe.Coerce (unsafeCoerce)

newtype BrowserConfig = BrowserConfig { wrapRenderer :: RenderWrapper
                                      , browser :: BrowserConstructor
                                      , tracks :: TracksMap
                                      }

parseBrowserConfig :: Foreign -> F BrowserConfig
parseBrowserConfig f = do
  wrapRenderer <- f ! "wrapRenderer" >>= unsafeReadTagged "Function"
  browser <- f ! "browser" >>= unsafeReadTagged "Function"
  tracks <- f ! "tracks"
  tracksKeys <- (map readTrackType) <$> keys tracks
  when (null tracksKeys) $ fail $ ForeignError "TracksMap is empty"
  when (not $ all isJust tracksKeys) $ fail $ ForeignError "TracksMap keys are not all TrackType"

  let tracks' = unsafeCoerce tracks
  pure $ BrowserConfig { wrapRenderer, browser, tracks: tracks' }

Improve error messages on browser validation

module Genetics.Browser.Config
       where

import Prelude
import Control.Monad.Except (withExcept)
import Data.Array (null)
import Data.Foldable (all)
import Data.Foreign (F, Foreign, ForeignError(..), fail, unsafeReadTagged)
import Data.Foreign.Index ((!))
import Data.Foreign.Keys (keys)
import Data.Maybe (isJust)
import Genetics.Browser.Biodalliance (BrowserConstructor, RenderWrapper)
import Genetics.Browser.Config.Track (TracksMap, readTrackType)
import Unsafe.Coerce (unsafeCoerce)

newtype BrowserConfig = BrowserConfig { wrapRenderer :: RenderWrapper
                                      , browser :: BrowserConstructor
                                      , tracks :: TracksMap
                                      }

readTaggedWithError :: forall a. String -> String -> Foreign -> F a
readTaggedWithError s e f = withExcept ((<>) (pure $ ForeignError e)) $ unsafeReadTagged s f

parseBrowserConfig :: Foreign -> F BrowserConfig
parseBrowserConfig f = do
  wrapRenderer <- f ! "wrapRenderer" >>= readTaggedWithError "Function" "Error on 'wrapRenderer':"
  browser <- f ! "browser" >>= readTaggedWithError "Function" "Error on 'browser':"
  tracks <- f ! "tracks"
  tracksKeys <- (map readTrackType) <$> keys tracks
  when (null tracksKeys) $ fail $ ForeignError "TracksMap is empty"
  when (not $ all isJust tracksKeys) $ fail $ ForeignError "TracksMap keys are not all TrackType"
  let tracks' = unsafeCoerce tracks
  pure $ BrowserConfig { wrapRenderer, browser, tracks: tracks' }


module Main where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgs :: Array String -> Maybe (String)
getArgs args = tail args >>= tail >>= head

getArgsDo :: Array String -> Maybe (String)
getArgsDo args = do
  a <- tail args
  b <- tail a
  head b

get :: Maybe String -> String
get (Just str) = str
get Nothing    = ""

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (get (getArgsDo arr)))

Use specified imports and rename getArgs to getArgsBind

module Main where

import Prelude (Unit, bind, (<>), (>>=))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (head, tail)
import Data.Maybe (Maybe(..))
import Node.Process (PROCESS, argv)

greeting :: String -> String
greeting who = "Hello " <> who <> "!"

getArgsBind :: Array String -> Maybe (String)
getArgsBind args = tail args >>= tail >>= head

getArgsDo :: Array String -> Maybe (String)
getArgsDo args = do
  a <- tail args
  b <- tail a
  head b

get :: Maybe String -> String
get (Just str) = str
get Nothing    = ""

main :: forall eff. Eff (console :: CONSOLE, process :: PROCESS | eff) Unit
main = do
  arr <- argv
  log (greeting (get (getArgsBind arr)))


module Main where

import Control.Monad.Eff

main = vue
    {
        el: "#demo",
        dat: { message: "Hello Vue.js!" }
    }

foreign import vue
    "function vue(opt) {\
    \    return function() {\
    \        if (opt.dat !== undefined) {\
    \            opt.data = opt.dat;\
    \            delete opt.dat;\
    \        }\
    \        new Vue(opt);\
    \    }\
    \}" :: forall e r. { el :: String | r } -> Eff e {}

Make vue return Vue :: *

module Main where

import Control.Monad.Eff

main = vue
    {
        el: "#demo",
        dat: { message: "Hello Vue.js!" }
    }

foreign import data Vue :: *

foreign import vue
    "function vue(opt) {\
    \    return function() {\
    \        if (opt.dat !== undefined) {\
    \            opt.data = opt.dat;\
    \            delete opt.dat;\
    \        }\
    \        return new Vue(opt);\
    \    }\
    \}" :: forall e r s. { el :: String | r } -> Eff e Vue


module Main where

import qualified Control.Monad.JQuery as J
import           Control.Monad.Eff
import DOM
import Data.Foreign (readString)

import Data.Either
import Data.Maybe

import Web
import Parser
import Evaluator
import AST

import Debug.Trace

main = J.ready $ do
  input       <- J.select "#input"       >>= getValue
  definitions <- J.select "#definitions" >>= getValue
  output      <- J.select "#output"
  info        <- J.select "#info"

  let expr = case parseExpr input of Right e -> e
  let env = defsToEnv $ case parseDefs definitions of Right d -> d
  showExpr env expr End
  return unit

showExpr :: forall eff. Env -> Expr -> Path -> Eff (dom :: DOM | eff) Unit
showExpr env expr path =
  case evalPath1 env path expr of
    Nothing    -> return unit
    Just expr' -> do
      test <- J.select "#output"
      J.clear test
      jexpr <- exprToJQuery expr' (showExpr env)
      J.append jexpr test
      return unit

getValue :: forall eff. J.JQuery -> Eff (dom :: DOM | eff) String
getValue j = do
  value <- J.getValue j
  case readString value of
    Right str -> return str

Stop evaluating after page reload

module Main where

import qualified Control.Monad.JQuery as J
import           Control.Monad.Eff
import DOM
import Data.Foreign (readString)

import Data.Either
import Data.Maybe

import Web
import Parser
import Evaluator
import AST

import Debug.Trace

main = J.ready $ do
  input       <- J.select "#input"       >>= getValue
  definitions <- J.select "#definitions" >>= getValue
  output      <- J.select "#output"
  info        <- J.select "#info"

  let expr = case parseExpr input of Right e -> e
  let env = defsToEnv $ case parseDefs definitions of Right d -> d
  showExpr env expr
  return unit

showExpr :: forall eff. Env -> Expr -> Eff (dom :: DOM | eff) Unit
showExpr env expr = do
  test <- J.select "#output"
  J.clear test
  jexpr <- exprToJQuery expr (evalExpr env)
  J.append jexpr test
  return unit

evalExpr :: forall eff. Env -> Expr -> Path -> Eff (dom :: DOM | eff) Unit
evalExpr env expr path =
  case evalPath1 env path expr of
    Nothing    -> return unit
    Just expr' -> do
      showExpr env expr'

getValue :: forall eff. J.JQuery -> Eff (dom :: DOM | eff) String
getValue j = do
  value <- J.getValue j
  case readString value of
    Right str -> return str


module Main where

type Foo = (x :: Number | (y :: Number | (z :: Number)))
type Bar = (x :: Number, y :: Number, z :: Number)
type Baz = { w :: Number | Bar }

foo :: { | Foo }
foo = { x: 0, y: 0, z: 0 }

bar :: { | Bar }
bar = { x: 0, y: 0, z: 0 }

id' :: Object Foo -> Object Bar
id' = id

foo' :: { | Foo }
foo' = id' foo

bar' :: { | Bar }
bar' = id' bar

baz :: Baz
baz = { x: 0, y: 0, z: 0, w: 0 }

main = Debug.Trace.trace "Done"


Test for referencing unexported values within a module

module M1 (bar) where

  foo :: Number
  foo = 0

  bar :: Number
  bar = foo

module Main where

  import M1

  testBar = bar

  main = Debug.Trace.trace "Done"


Read a location (reference) once with a default value

module Test.ReadSpec where

import Prelude (Unit, bind, ($))

import Control.Apply ((*>))
import Control.Monad.Aff (attempt)
import Control.Monad.Eff.Exception (EXCEPTION(), message)
import Control.Alt ((<|>))
import Data.Either (either)
import Data.Foreign (toForeign)
import Web.Firebase.Types as FBT
import Web.Firebase (EventType(ChildMoved, ChildChanged, ChildRemoved, ChildAdded))
import Test.Spec                  (describe, it, Spec())
import Test.Spec.Assertions       (shouldEqual)
import Test.Spec.Assertions.Aff (expectError)
import Web.Firebase.Monad.Aff (child, readOnceWithDefault)

-- | Reading from references and snapshots, sometimes with defaults
-- reading, as in also converting from foreign with some form of `read`
readSpec :: forall eff. FBT.Firebase -> Spec (firebase :: FBT.FirebaseEff, err :: EXCEPTION | eff ) Unit
readSpec entries = do
    describe "Reading records and newtypes" do
        describe "with a default value" do
          it "returns default value on non-existant, but allowed location" do
            nodataLocation <- child "/nodata" entries
            nodata <- readOnceWithDefault "no data" nodataLocation
            nodata `shouldEqual` "no data"


module M1 where

  trace x = x

module Main where

  import Prelude
  import Control.Monad.Eff
  import M1
  import qualified Debug.Trace as T

  main = T.trace (trace "Done")


module Web.Firebase.UnsafeRef
  ( refFor
  ) where

import Control.Monad.Aff
import Control.Monad.Eff.Class (liftEff)
import Data.Either.Unsafe  (fromRight)
import Data.URI (runParseURI)
import qualified Web.Firebase as FB
import qualified Web.Firebase.Types as FBT

-- | Unsafely read a string that might be a reference, and turn it into a firebase reference
-- may throw javascript exceptions, intended to keep test code terse, not meant for production usage
refFor :: String -> forall eff. Aff (firebase :: FBT.FirebaseEff | eff) FBT.Firebase
refFor s = do
  let fbUri = fromRight (runParseURI s)
  liftEff (FB.newFirebase fbUri)


Test for accidental renamer ident shadowing

module Main where

import Control.Monad.Eff
import Debug.Trace

foreign import f
  "function f(x) {\
  \  return function () {\
  \    if (x !== 2) throw new Error('x is not 2');\
  \  }\
  \}" :: forall e. Number -> Eff e Number

foo foo = let foo_1 = \_ -> foo
              foo_2 = foo_1 unit + 1
          in foo_2

main = do
  f (foo 1)
  trace "Done"


module Genetics.Browser.Types where

import Data.Foreign (Foreign)

type Point = { x :: Number, y :: Number}

type View = { viewStart :: Number
            , scale :: Number
            , height :: Number
            }

-- TODO: replace Array Foreign with Array ForeignFeature
-- or similar, for clarity. Could be a newtype or type synonym
type Renderer = View -> Array Foreign -> Foreign

Include current chromosome in view, since it's used by BD features.

module Genetics.Browser.Types where

import Data.Foreign (Foreign)

type Point = { x :: Number, y :: Number}

type View = { viewStart :: Number
            , scale :: Number
            , height :: Number
            , chr :: String
            }

-- TODO: replace Array Foreign with Array ForeignFeature
-- or similar, for clarity. Could be a newtype or type synonym
type Renderer = View -> Array Foreign -> Foreign


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'


module ThirdTab
  ( class ColT
  ) where

import Data.List

class ColT a

type Cells a = List a

newtype ThirdTab colTypes = ThirdTab
  { cols :: List colTypes
  , rows :: List (Cells colTypes)
  }

empty :: forall a. ColT a => ThirdTab a
empty = ThirdTab
  { cols : Nil
  , rows : Nil
  }

addColumn :: forall a. ColT a => Int -> String -> ThirdTab a -> ThirdTab a
addColumn id name (ThirdTab table) = ThirdTab { cols: table.cols, rows: table.rows }


module Test.Main where

import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Eff (Eff)
import Data.Generic (class Generic, gEq, gShow)
import Data.Maybe (Maybe(..))
import Prelude (bind, class Eq, class Show, Unit)
import Test.Unit (test, runTest, TIMER)
import Test.Unit.Console (TESTOUTPUT)
import Test.Unit.Assert (equal)
import Text.Boomerang.String (parse, serialize)
import Routing.Bob (bob)
import Type.Proxy (Proxy(..))

data BooleanIntRoute = BooleanIntRoute
  { extended :: Boolean
  , id :: Int
  }
derive instance genericBooleanIntRoute :: Generic BooleanIntRoute

data PrimitivePositionalValue = PrimitivePositionalValue Int
derive instance genericPrimitivePositionalValue :: Generic PrimitivePositionalValue
instance eqPrimitivePositionalValue :: Eq PrimitivePositionalValue where
  eq = gEq
instance showPrimitivePositionalValue :: Show PrimitivePositionalValue where
  show = gShow

data PrimitivePositionalValues = PrimitivePositionalValues Int Boolean Int
derive instance genericPrimitivePositionalValues :: Generic PrimitivePositionalValues
instance eqPrimitivePositionalValues :: Eq PrimitivePositionalValues where
  eq = gEq
instance showPrimitivePositionalValues :: Show PrimitivePositionalValues where
  show = gShow

data UnionOfPrimitivePositionalValues =
    FirstConstructor Int Boolean Int
  | SecondConstructor Int Boolean Int
derive instance genericUnionOfPrimitivePositionalValues :: Generic UnionOfPrimitivePositionalValues
instance eqUnionOfPrimitivePositionalValues :: Eq UnionOfPrimitivePositionalValues where
  eq = gEq
instance showUnionOfPrimitivePositionalValues :: Show UnionOfPrimitivePositionalValues where
  show = gShow

main :: forall e. Eff ( timer :: TIMER
                      , avar :: AVAR
                      , testOutput :: TESTOUTPUT | e
                      ) Unit
main = runTest do
  test "bob handles constructor with single, primitive value" do
    let route = bob (Proxy :: Proxy PrimitivePositionalValue)
        obj = PrimitivePositionalValue 8
    equal (Just "/8") (serialize route obj)
    equal (Just obj) (parse route "/8")

  test "gRoute handles construtor with multiple, primitive values" do
    let route = bob (Proxy :: Proxy PrimitivePositionalValues)
        obj = PrimitivePositionalValues 8 true 9
    equal (Just "/8/on/9") (serialize route obj)
    equal (Just obj) (parse route "/8/on/9")


module Main where

newtype Id = Id forall a. a -> a

runId = \id a -> case id of
  Id f -> f a

newtype Nat = Nat forall r. r -> (r -> r) -> r

runNat = \nat -> case nat of
  Nat f -> f 0 (\n -> n + 1)

zero = Nat (\zero _ -> zero)

succ = \n -> case n of
  Nat f -> Nat (\zero succ -> succ (f zero succ))

add = \n m -> case n of
  Nat f -> case m of
    Nat g -> Nat (\zero succ -> g (f zero succ) succ)

one = succ zero
two = succ zero
four = add two two
fourNumber = runNat four

main = Debug.Trace.trace "Done"


Add test for Prelude's unsafeCompare FFI call

module Main where

import Control.Monad.Eff
import Debug.Trace

foreign import data Assert :: !

foreign import assert
  "function assert(x) {\
  \  return function () {\
  \    if (!x) throw new Error('assertion failed');\
  \    return {};\
  \  };\
  \};" :: forall e. Boolean -> Eff (assert :: Assert | e) Unit

main = do
  assert (1 < 2)
  assert (2 == 2)
  assert (3 > 1)
  assert ("a" < "b")
  assert ("a" == "a")
  assert ("z" > "a")
  trace "Done!"


Add functions for parsing TrackSource/Sink configs

module Genetics.Browser.Config.Events where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Except (throwError)
import Data.Argonaut (Json, _Object, (.?))
import Data.Either (Either)
import Data.Foreign (F, Foreign, readString, unsafeReadTagged)
import Data.Foreign.Index ((!))
import Data.Lens ((^?))
import Data.Maybe (Maybe(..))
import Genetics.Browser.Biodalliance.Types (Biodalliance)
import Genetics.Browser.Cytoscape.Types (Cytoscape)
import Genetics.Browser.Events.TrackSink (SinkConfig)
import Genetics.Browser.Events.TrackSource (SourceConfig)
import Unsafe.Coerce (unsafeCoerce)

parseTrackSourceConfig :: Foreign -> F SourceConfig
parseTrackSourceConfig for = do
  eventName <- readString =<< for ! "eventName"
  eventTemplate <- for ! "eventTemplate"
  rawTemplate <- for ! "rawTemplate"
  pure $ { eventName
         , eventTemplate: unsafeCoerce eventTemplate
         , rawTemplate: unsafeCoerce rawTemplate
         }

-- this is so unsafe
parseTrackSinkConfig :: ∀ a. Foreign -> F (SinkConfig a)
parseTrackSinkConfig for = do
  eventName <- readString =<< for ! "eventName"
  eventFun <- for ! "eventTemplate" >>= unsafeReadTagged "Function"
  pure $ { eventName
         , eventFun: unsafeCoerce eventFun
         }

parseBDTrackSinkConfig :: Foreign
                       -> F (SinkConfig (Biodalliance -> Eff _ Unit))
parseBDTrackSinkConfig f = unsafeCoerce (parseTrackSinkConfig f)

parseCyGraphSinkConfig :: Foreign
                       -> F (SinkConfig (Cytoscape -> Eff _ Unit))
parseCyGraphSinkConfig f = unsafeCoerce (parseTrackSinkConfig f)


Add type & function for creating BD track configs

module Genetics.Browser.Config.Track
       where

import Prelude
import Data.Foreign (Foreign, toForeign)

newtype BDTrackConfig = BDTrackConfig Foreign

makeBDTrack :: ∀ r. { name :: String, renderer :: String | r } -> BDTrackConfig
makeBDTrack = (BDTrackConfig <<< toForeign)


module Util.Types where

import Prelude ((<$>))

import Data.Argonaut
import Color (Color, toRGBA)

newtype Color' = Color' Color
newtype Colors' = Colors' (Array Color')

instance encodeJsonColor :: EncodeJson Color' where
  encodeJson (Color' color)
     = "red"   := rgba.r
    ~> "green" := rgba.g
    ~> "blue"  := rgba.b
    ~> "alpha" := rgba.a
    ~> jsonEmptyObject
      where rgba = toRGBA color

instance encodeJsonColors :: EncodeJson Colors' where
  encodeJson (Colors' colors)
     = "compatibleVersion" := "1.4"
    ~> "pluginVersion"     := "1.4"
    ~> "colors"            := fromArray (encodeJson <$> colors)
    ~> jsonEmptyObject


Add module for simpler testing in 'psci' (repl)

module Tests where

import Data.Either

import AST
import Parser
import Evaluator

testEnv :: Env
testEnv = defsToEnv $ case (Parser.parseDefs defs) of Right env -> env
  where
  defs = """
    double x = x + x
    fact 0 = 1
    fact n = n * fact (n - 1)
    fib 0 a b = a
    fib n a b = fib (n - 1) b (a + b)
    """

testExpr :: String -> Expr
testExpr str = case (Parser.parseExpr str) of Right expr -> expr


Add 99 bottles implementation in VBScript

Function bottles(n)
    bottles = n & " bottle" : if n > 1 then bottles = bottles & "s"
End Function

WScript.Echo bottles(99) & " of beer on the wall, " & bottles(99) & " of beer."
for i = 98 to 1 step -1
    WScript.Echo "Take one down and pass it around, " & bottles(i) & " of beer on the wall."
    WScript.Echo bottles(i) & " of beer on the wall, " & bottles(i) & " of beer."
next
WScript.Echo "Take one down and pass it around, no more bottles of beer on the wall." _
    & vbCRLF & "No more bottles of beer on the wall, no more bottles of beer." _
    & vbCRLF & "Go to the store and buy some more, 99 bottles of beer on the wall."


Set objShell = CreateObject("Shell.Application")
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("PROCESS")

strCommandLine = "/c presetup-win.cmd & pause"
strApplication = "cmd.exe"

objShell.ShellExecute strApplication, strCommandLine, "", "runas"

Fix to VBS to use path to profile

Set objShell = CreateObject("Shell.Application")
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("PROCESS")

strPath = objWshShell.ExpandEnvironmentStrings( "%USERPROFILE%" )
strCommandLine = "/c " & strPath & "\presetup-win.cmd & pause"
strApplication = "cmd.exe"

objShell.ShellExecute strApplication, strCommandLine, "", "runas"


Imports System
Imports System.Data.Entity
Imports System.Data.Entity.Migrations
Imports System.Linq

Namespace Migrations

    Public NotInheritable Class FamilyMigrationConfiguration
        Inherits DbMigrationsConfiguration(Of FamilyEntities)

        Public Sub New()
            AutomaticMigrationsEnabled = False
            Me.MigrationsDirectory = "Migrations\Family"
        End Sub

        Protected Overrides Sub Seed(context As FamilyEntities)
            '  This method will be called after migrating to the latest version.

            '  You can use the DbSet(Of T).AddOrUpdate() helper extension method
            '  to avoid creating duplicate seed data. E.g.
            '
            '    context.People.AddOrUpdate(
            '       Function(c) c.FullName,
            '       New Customer() With {.FullName = "Andrew Peters"},
            '       New Customer() With {.FullName = "Brice Lambson"},
            '       New Customer() With {.FullName = "Rowan Miller"})
        End Sub

    End Class

End Namespace

Add sample data to seed to show example.

Imports System
Imports System.Data.Entity
Imports System.Data.Entity.Migrations
Imports System.Linq

Namespace Migrations

    Public NotInheritable Class FamilyMigrationConfiguration
        Inherits DbMigrationsConfiguration(Of FamilyEntities)

        Public Sub New()
            AutomaticMigrationsEnabled = False
            Me.MigrationsDirectory = "Migrations\Family"
        End Sub

        Protected Overrides Sub Seed(context As FamilyEntities)
            '  This method will be called after migrating to the latest version.

            '  You can use the DbSet(Of T).AddOrUpdate() helper extension method
            '  to avoid creating duplicate seed data. E.g.
            '
            '    context.People.AddOrUpdate(
            '       Function(c) c.FullName,
            '       New Customer() With {.FullName = "Andrew Peters"},
            '       New Customer() With {.FullName = "Brice Lambson"},
            '       New Customer() With {.FullName = "Rowan Miller"})

            'Dim Jay As Member = New Member With {.FirstName = "Jay", .LastName = "Asbury"}
            'context.Members.AddOrUpdate(Function(m) New With {m.FirstName, m.LastName},
            '                            Jay,
            '                            New Member With {.FirstName = "Nina", .LastName = "Asbury"})

            'context.PhoneNumbers.AddOrUpdate(Function(p) New With {p.MemberID, p.Phone},
            '                                     New PhoneNumber With {.MemberID = Jay.MemberId, .Phone = "3361234567", .PhoneType = "Home", .IsPrivate = False},
            '                                     New PhoneNumber With {.MemberID = Jay.MemberId, .Phone = "3367654321", .PhoneType = "Cell", .IsPrivate = True})
        End Sub

    End Class

End Namespace


Imports System.Drawing.Imaging
Imports HolzShots.UI.Forms
Imports HolzShots.Windows.Forms

Friend Module GlobalVariables

    Friend GlobalContextMenuRenderer As ToolStripRenderer = New ToolStripAeroRenderer(ToolBarTheme.MediaToolbar)
    Friend GlobalSubMenuContextMenuRenderer As ToolStripRenderer = New VSRenderer()

    Public Const SupportedFilesFilter As String = "*.bmp;*.jpg;*.jpeg;*.png;*.gif;*.tif;*.tiff"

    Public ReadOnly DefaultImageFormat As ImageFormat = ImageFormat.Png
    Public Const DefaultFileExtension = ".png"
    Friend Const DefaultFileName = "HolzShots"

    Friend Const AreaSelectorParameter As String = "-selector" ' TODO: Refactor command line
    Friend Const FullscreenScreenshotParameter As String = "-fullscreen" ' TODO: Refactor command line

    Friend Const OpenParameter As String = "-open" ' TODO: Refactor command line
    Friend Const UploadParameter As String = "-upload" ' TODO: Refactor command line

    Friend Const OpenFromShellParameter As String = "-open_shell" ' TODO: Refactor command line
    Friend Const UploadFromShellParameter As String = "-upload_shell" ' TODO: Refactor command line
End Module

Change CLI params to be more conform with anything

Imports System.Drawing.Imaging
Imports HolzShots.UI.Forms
Imports HolzShots.Windows.Forms

Friend Module GlobalVariables

    Friend GlobalContextMenuRenderer As ToolStripRenderer = New ToolStripAeroRenderer(ToolBarTheme.MediaToolbar)
    Friend GlobalSubMenuContextMenuRenderer As ToolStripRenderer = New VSRenderer()

    Public Const SupportedFilesFilter As String = "*.bmp;*.jpg;*.jpeg;*.png;*.gif;*.tif;*.tiff"

    Public ReadOnly DefaultImageFormat As ImageFormat = ImageFormat.Png
    Public Const DefaultFileExtension = ".png"
    Friend Const DefaultFileName = "HolzShots"

    Friend Const AreaSelectorParameter As String = "--capture-area"
    Friend Const FullscreenScreenshotParameter As String = "--capture-full"

    Friend Const OpenParameter As String = "--open-image"
    Friend Const UploadParameter As String = "--upload-image"

    Friend Const OpenFromShellParameter As String = "--open-via-shell"
    Friend Const UploadFromShellParameter As String = "--upload-via-shell"
End Module


FileName = WScript.Arguments(0)

' We want to replace absolute paths with ones that are relative to the current folder
set WshShell = WScript.CreateObject("WScript.Shell")
CurDir = WshShell.CurrentDirectory
OrigText = Replace(CurDir, "\", "/", 1, -1, 1)
'Read source text file
FileContents = GetFile(FileName)

'replace all string In the source file
dFileContents = Replace(FileContents, OrigText, "../..", 1, -1, 1)

' Update if different
if dFileContents <> FileContents Then WriteFile FileName, dFileContents

'Read text file
function GetFile(FileName)
	If FileName<>"" Then
		Dim FS, FileStream
		Set FS = CreateObject("Scripting.FileSystemObject")
		on error resume Next
		Set FileStream = FS.OpenTextFile(FileName)
		GetFile = FileStream.ReadAll
	End If
End Function

'Write string As a text file.
function WriteFile(FileName, Contents)
	Dim OutStream, FS

	on error resume Next
	Set FS = CreateObject("Scripting.FileSystemObject")
	Set OutStream = FS.OpenTextFile(FileName, 2, True)
	OutStream.Write Contents
End Function

Fix VC10 SDK generation to make SDK samples compile again

FileName = WScript.Arguments(0)

' We want to replace absolute paths with ones that are relative to the current folder
set WshShell = WScript.CreateObject("WScript.Shell")
CurDir = WshShell.CurrentDirectory
OrigText = Replace(CurDir, "\", "/", 1, -1, 1)
'Read source text file
FileContents = GetFile(FileName)

'replace all string In the source file
cFileContents = Replace(FileContents, OrigText, "../..", 1, -1, 1)
dFileContents = Replace(cFileContents, CurDir, "..\..", 1, -1, 1)

' Update if different
if dFileContents <> FileContents Then WriteFile FileName, dFileContents

'Read text file
function GetFile(FileName)
	If FileName<>"" Then
		Dim FS, FileStream
		Set FS = CreateObject("Scripting.FileSystemObject")
		on error resume Next
		Set FileStream = FS.OpenTextFile(FileName)
		GetFile = FileStream.ReadAll
	End If
End Function

'Write string As a text file.
function WriteFile(FileName, Contents)
	Dim OutStream, FS

	on error resume Next
	Set FS = CreateObject("Scripting.FileSystemObject")
	Set OutStream = FS.OpenTextFile(FileName, 2, True)
	OutStream.Write Contents
End Function


REM Install .NET Framework
REM https://support.microsoft.com/en-ca/help/3102436/the-net-framework-4-6-1-offline-installer-for-windows
Dim oShell
set oShell = CreateObject("Wscript.Shell")
cd = (oShell.CurrentDirectory)
cmd = cd + "\DotNet\NDP461-KB3102436-x86-x64-AllOS-ENU.exe /norestart /passive /showrmui"
REM wscript.echo cmd
oShell.run cmd


<Serializable()> _
Public Class ProjectList
  Inherits ReadOnlyListBase(Of ProjectList, ProjectInfo)

#Region " Factory Methods "

  Public Shared Function GetProjectList() As ProjectList

    Return DataPortal.Fetch(Of ProjectList)()

  End Function

  Public Shared Function GetProjectList(ByVal name As String) As ProjectList

    Return DataPortal.Fetch(Of ProjectList)(New SingleCriteria(Of ProjectList, String)(name))

  End Function

  Private Sub New()
    ' require use of factory methods
  End Sub

#End Region

#Region " Data Access "

  Private Overloads Sub DataPortal_Fetch()

    ' fetch with no filter
    Fetch("")

  End Sub

  Private Overloads Sub DataPortal_Fetch(ByVal criteria As SingleCriteria(Of ProjectList, String))

    Fetch(criteria.Value)

  End Sub

  Private Sub Fetch(ByVal nameFilter As String)

    RaiseListChangedEvents = False
    Using ctx = ContextManager(Of ProjectTracker.DalLinq.PTrackerDataContext).GetManager(Database.PTrackerConnection)
      Dim data = From p In ctx.DataContext.Projects Select p
      If Not String.IsNullOrEmpty(nameFilter) Then _
        data = From p In data Where p.Name Like nameFilter Select p
      IsReadOnly = False
      For Each project In data
        Me.Add(New ProjectInfo(project.Id, project.Name))
      Next
      IsReadOnly = True
    End Using
    RaiseListChangedEvents = True

  End Sub

#End Region

End Class

Implement wildcard in Like clause.

<Serializable()> _
Public Class ProjectList
  Inherits ReadOnlyListBase(Of ProjectList, ProjectInfo)

#Region " Factory Methods "

  Public Shared Function GetProjectList() As ProjectList

    Return DataPortal.Fetch(Of ProjectList)()

  End Function

  Public Shared Function GetProjectList(ByVal name As String) As ProjectList

    Return DataPortal.Fetch(Of ProjectList)(New SingleCriteria(Of ProjectList, String)(name))

  End Function

  Private Sub New()
    ' require use of factory methods
  End Sub

#End Region

#Region " Data Access "

  Private Overloads Sub DataPortal_Fetch()

    ' fetch with no filter
    Fetch("")

  End Sub

  Private Overloads Sub DataPortal_Fetch(ByVal criteria As SingleCriteria(Of ProjectList, String))

    Fetch(criteria.Value)

  End Sub

  Private Sub Fetch(ByVal nameFilter As String)

    RaiseListChangedEvents = False
    Using ctx = ContextManager(Of ProjectTracker.DalLinq.PTrackerDataContext).GetManager(Database.PTrackerConnection)
      Dim data = From p In ctx.DataContext.Projects Select p
      If Not String.IsNullOrEmpty(nameFilter) Then _
        data = From p In data Where p.Name Like "*" & nameFilter & "*" Select p
      IsReadOnly = False
      For Each project In data
        Me.Add(New ProjectInfo(project.Id, project.Name))
      Next
      IsReadOnly = True
    End Using
    RaiseListChangedEvents = True

  End Sub

#End Region

End Class


Imports Microsoft.VisualBasic
Imports System
Imports System.IO
Imports System.Drawing
Imports Aspose.Words
Imports Aspose.Words.Layout
Imports Aspose.Words.Rendering
Public Class HyphenateWordsOfLanguages
    Public Shared Sub Run()
        ' ExStart:HyphenateWordsOfLanguages
        ' The path to the documents directory.
        Dim dataDir As String = RunExamples.GetDataDir_RenderingAndPrinting()

        ' Load the documents which store the shapes we want to render.
        Dim doc As New Document(dataDir & Convert.ToString("TestFile RenderShape.doc"))
        Hyphenation.RegisterDictionary("en-US", dataDir & Convert.ToString("hyph_en_US.dic"))
        Hyphenation.RegisterDictionary("de-CH", dataDir & Convert.ToString("hyph_de_CH.dic"))

        dataDir = dataDir & Convert.ToString("HyphenateWordsOfLanguages_out_.pdf")
        doc.Save(dataDir)
        'ExEnd:HyphenateWordsOfLanguages
        Console.WriteLine(Convert.ToString(vbLf & "Words of special languages hyphenate successfully." & vbLf & "File saved at ") & dataDir)
    End Sub
End Class

Fix Code snippet for HyphenateWordsOfLanuages

Imports Microsoft.VisualBasic
Imports System
Imports System.IO
Imports System.Drawing
Imports Aspose.Words
Imports Aspose.Words.Layout
Imports Aspose.Words.Rendering
Public Class HyphenateWordsOfLanguages
    Public Shared Sub Run()
        ' ExStart:HyphenateWordsOfLanguages
        ' The path to the documents directory.
        Dim dataDir As String = RunExamples.GetDataDir_RenderingAndPrinting()

        ' Load the documents which store the shapes we want to render.
        Dim doc As New Document(dataDir & Convert.ToString("TestFile RenderShape.doc"))
        Hyphenation.RegisterDictionary("en-US", dataDir & Convert.ToString("hyph_en_US.dic"))
        Hyphenation.RegisterDictionary("de-CH", dataDir & Convert.ToString("hyph_de_CH.dic"))

        dataDir = dataDir & Convert.ToString("HyphenateWordsOfLanguages_out_.pdf")
        doc.Save(dataDir)
        ' ExEnd:HyphenateWordsOfLanguages
        Console.WriteLine(Convert.ToString(vbLf & "Words of special languages hyphenate successfully." & vbLf & "File saved at ") & dataDir)
    End Sub
End Class


Add to common tools script execturing devenv (Visual Studio) from command line.

' $1 - Visual studio version to run (10 or 11)
' $2 ... Parameters to pass

Dim strCmdLine, strTemp
Set WshShell = Wscript.CreateObject("Wscript.Shell")
strCmdLine = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\VisualStudio\" + Wscript.Arguments(0) + ".0\InstallDir")
strCmdLine = chr(34) + strCmdLine + "devenv.com" + chr(34)
For i = 0 to (Wscript.Arguments.Count - 1)
  If i > 0 Then
  	strTemp = Wscript.Arguments(i)
  	If InStr(strTemp, " ") Or InStr(strTemp, "|") Then
  		strCmdLine = strCmdLine + " " + chr(34) + strTemp + chr(34)
  	Else
  		strCmdLine = strCmdLine + " " + strTemp
  	End If
  End If
Next

WScript.Echo "Running " + strCmdLine + vbCrLf
errorLevel = WshShell.Run(strCmdLine, 1, true)
Wscript.Quit errorLevel


Imports System.Resources

Public Class Strings

  Public Shared rm As New ResourceManager("Resources.Strings", _
    System.Reflection.Assembly.GetExecutingAssembly())

  Public Shared Function GetResourceString(ByVal name As String) As String

    Return rm.GetString(name)

  End Function

End Class

Use full type name for class.

Imports System.Resources

Public Class Strings

  Public Shared rm As New ResourceManager("CSLA.Resources.Strings", _
    System.Reflection.Assembly.GetExecutingAssembly())

  Public Shared Function GetResourceString(ByVal name As String) As String

    Return rm.GetString(name)

  End Function

End Class


Imports DotNetNuke.Common.Utilities
Imports DotNetNuke.Services.Exceptions
Imports DotNetNuke.Services.Localization

Imports Ventrian.NewsArticles.Base

Namespace Ventrian.NewsArticles

    Partial Public Class ucEditTags
        Inherits NewsArticleModuleBase

#Region " Private Methods "

        Private Sub BindTags()

            Dim objTagController As New TagController

            Localization.LocalizeDataGrid(grdTags, Me.LocalResourceFile)

            grdTags.DataSource = objTagController.List(Me.ModuleId, Null.NullInteger)
            grdTags.DataBind()

            If (grdTags.Items.Count > 0) Then
                grdTags.Visible = True
                lblNoTags.Visible = False
            Else
                grdTags.Visible = False
                lblNoTags.Visible = True
                lblNoTags.Text = Localization.GetString("NoTagsMessage.Text", LocalResourceFile)
            End If

        End Sub

#End Region

#Region " Event Handlers "

        Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

            Try

                BindTags()

            Catch exc As Exception    'Module failed to load
                ProcessModuleLoadException(Me, exc)
            End Try

        End Sub

        Private Sub cmdAddTag_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdAddTag.Click

            Response.Redirect(EditUrl("EditTag"), True)

        End Sub

#End Region

    End Class

End Namespace

Sort tags list in EditTags view

Imports DotNetNuke.Common.Utilities
Imports DotNetNuke.Services.Exceptions
Imports DotNetNuke.Services.Localization

Imports Ventrian.NewsArticles.Base

Namespace Ventrian.NewsArticles

    Partial Public Class ucEditTags
        Inherits NewsArticleModuleBase

#Region " Private Methods "

        Private Sub BindTags()

            Dim objTagController As New TagController

            Localization.LocalizeDataGrid(grdTags, Me.LocalResourceFile)

            Dim objTags As ArrayList = objTagController.List(Me.ModuleId, Null.NullInteger)

            objTags.Sort()
            grdTags.DataSource = objTags
            grdTags.DataBind()

            If (grdTags.Items.Count > 0) Then
                grdTags.Visible = True
                lblNoTags.Visible = False
            Else
                grdTags.Visible = False
                lblNoTags.Visible = True
                lblNoTags.Text = Localization.GetString("NoTagsMessage.Text", LocalResourceFile)
            End If

        End Sub

#End Region

#Region " Event Handlers "

        Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

            Try

                BindTags()

            Catch exc As Exception    'Module failed to load
                ProcessModuleLoadException(Me, exc)
            End Try

        End Sub

        Private Sub cmdAddTag_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdAddTag.Click

            Response.Redirect(EditUrl("EditTag"), True)

        End Sub

#End Region

    End Class

End Namespace


# MODFLOW2005 Basic Package
#
free CONTHEADOUT
OPEN/CLOSE ref/umd_ibound.ref        1  (FREE)          -1     IBOUND Layer   1
OPEN/CLOSE ref/umd_ibound.ref        1  (FREE)          -1     IBOUND Layer   2
OPEN/CLOSE ref/umd_ibound.ref        1  (FREE)          -1     IBOUND Layer   3
9.9900e+02
OPEN/CLOSE ref/umd_ihead_navd.ref  1.0 (FREE)          -1     SHEAD  Layer   1
OPEN/CLOSE ref/umd_ihead_navd.ref  1.0 (FREE)          -1     SHEAD  Layer   2
OPEN/CLOSE ref/umd_ihead_navd.ref  1.0 (FREE)          -1     SHEAD  Layer   3


set oShell = WScript.CreateObject("WScript.Shell" )

strDesktop = oShell.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
projectHome = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")

set watirRobotLink = oShell.CreateShortcut(strDesktop & "\Watir Robot.lnk" )
watirRobotLink.TargetPath = projectHome & "\watir-robot-gui.jar"
watirRobotLink.WindowStyle = 1
watirRobotLink.IconLocation = projectHome & "\resources\watir_robot.ico"
watirRobotLink.Description = "Shortcut to Run Watir Robot GUI"
watirRobotLink.WorkingDirectory = projectHome
watirRobotLink.Save

set remoteServerLink = oShell.CreateShortcut(strDesktop & "\Remote Server.lnk" )
remoteServerLink.TargetPath = projectHome & "\bin\wr-run-server.bat"
remoteServerLink.WindowStyle = 1
remoteServerLink.IconLocation = projectHome & "\resources\remote_server.ico"
remoteServerLink.Description = "Shortcut to Run Watir Robot Remote Server"
remoteServerLink.WorkingDirectory = projectHome
remoteServerLink.Save

Update VBS script for new name of icon

set oShell = WScript.CreateObject("WScript.Shell" )

strDesktop = oShell.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
projectHome = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")

set watirRobotLink = oShell.CreateShortcut(strDesktop & "\Watir Robot.lnk" )
watirRobotLink.TargetPath = projectHome & "\start.bat"
watirRobotLink.WindowStyle = 1
watirRobotLink.IconLocation = projectHome & "\resources\watir_robot_gui.ico"
watirRobotLink.Description = "Shortcut to Run Watir Robot GUI"
watirRobotLink.WorkingDirectory = projectHome
watirRobotLink.Save

REM set remoteServerLink = oShell.CreateShortcut(strDesktop & "\Remote Server.lnk" )
REM remoteServerLink.TargetPath = projectHome & "\bin\wr-run-server.bat"
REM remoteServerLink.WindowStyle = 1
REM remoteServerLink.IconLocation = projectHome & "\resources\remote_server.ico"
REM remoteServerLink.Description = "Shortcut to Run Watir Robot Remote Server"
REM remoteServerLink.WorkingDirectory = projectHome
REM remoteServerLink.Save


' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
' See the LICENSE file in the project root for more information.

Imports System.Collections.Immutable
Imports Microsoft.CodeAnalysis.CodeStyle
Imports Microsoft.CodeAnalysis.Diagnostics
Imports Microsoft.CodeAnalysis.VisualBasic.Syntax

Namespace Microsoft.CodeAnalysis.VisualBasic.RemoveUnnecessaryByVal
    <DiagnosticAnalyzer(LanguageNames.VisualBasic)>
    Friend Class VisualBasicRemoveUnnecessaryByValDiagnosticAnalyzer
        Inherits AbstractCodeStyleDiagnosticAnalyzer

        Private Shared ReadOnly s_descriptor As DiagnosticDescriptor = New DiagnosticDescriptor(
            id:=IDEDiagnosticIds.RemoveUnnecessaryByValDiagnosticId,
            title:="",
            messageFormat:="",
            category:="",
            defaultSeverity:=DiagnosticSeverity.Hidden,
            isEnabledByDefault:=True,
            description:="",
            helpLinkUri:="",
            WellKnownDiagnosticTags.Unnecessary)

        Public Overrides ReadOnly Property SupportedDiagnostics As ImmutableArray(Of DiagnosticDescriptor) = ImmutableArray.Create(s_descriptor)

        Public Sub New()
            MyBase.New(s_descriptor.Id, s_descriptor.Title, s_descriptor.MessageFormat)
        End Sub

        Protected Overrides Sub InitializeWorker(ByVal context As AnalysisContext)
            context.RegisterSyntaxNodeAction(
            Sub(syntaxContext As SyntaxNodeAnalysisContext)
                Dim modifiers = CType(syntaxContext.Node, ParameterSyntax).Modifiers
                For Each modifier In modifiers
                    If modifier.IsKind(SyntaxKind.ByValKeyword) Then
                        syntaxContext.ReportDiagnostic(DiagnosticHelper.Create(
                                s_descriptor, modifier.GetLocation(), ReportDiagnostic.Hidden, additionalLocations:=Nothing, properties:=Nothing))
                    End If
                Next

            End Sub, SyntaxKind.Parameter)
        End Sub
    End Class
End Namespace

Delete ByVal and fix formatting

' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
' See the LICENSE file in the project root for more information.

Imports System.Collections.Immutable
Imports Microsoft.CodeAnalysis.CodeStyle
Imports Microsoft.CodeAnalysis.Diagnostics
Imports Microsoft.CodeAnalysis.VisualBasic.Syntax

Namespace Microsoft.CodeAnalysis.VisualBasic.RemoveUnnecessaryByVal
    <DiagnosticAnalyzer(LanguageNames.VisualBasic)>
    Friend Class VisualBasicRemoveUnnecessaryByValDiagnosticAnalyzer
        Inherits AbstractCodeStyleDiagnosticAnalyzer

        Private Shared ReadOnly s_descriptor As DiagnosticDescriptor = New DiagnosticDescriptor(
            id:=IDEDiagnosticIds.RemoveUnnecessaryByValDiagnosticId,
            title:="",
            messageFormat:="",
            category:="",
            defaultSeverity:=DiagnosticSeverity.Hidden,
            isEnabledByDefault:=True,
            description:="",
            helpLinkUri:="",
            WellKnownDiagnosticTags.Unnecessary)

        Public Overrides ReadOnly Property SupportedDiagnostics As ImmutableArray(Of DiagnosticDescriptor) = ImmutableArray.Create(s_descriptor)

        Public Sub New()
            MyBase.New(s_descriptor.Id, s_descriptor.Title, s_descriptor.MessageFormat)
        End Sub

        Protected Overrides Sub InitializeWorker(context As AnalysisContext)
            context.RegisterSyntaxNodeAction(
                Sub(syntaxContext As SyntaxNodeAnalysisContext)
                    Dim modifiers = CType(syntaxContext.Node, ParameterSyntax).Modifiers
                    For Each modifier In modifiers
                        If modifier.IsKind(SyntaxKind.ByValKeyword) Then
                            syntaxContext.ReportDiagnostic(DiagnosticHelper.Create(
                                s_descriptor, modifier.GetLocation(), ReportDiagnostic.Hidden, additionalLocations:=Nothing, properties:=Nothing))
                        End If
                    Next

                End Sub, SyntaxKind.Parameter)
        End Sub
    End Class
End Namespace