fix comment

fix comment

-- | Wraps the functions of Javascript's `String` object.
-- | A String represents a sequence of characters.
-- | For details of the underlying implementation, see [String Reference at MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String).
module Data.String
  ( Pattern(..)
  , Replacement(..)
  , charAt
  , charCodeAt
  , fromCharArray
  , toChar
  , contains
  , indexOf
  , indexOf'
  , lastIndexOf
  , lastIndexOf'
  , null
  , uncons
  , length
  , singleton
  , localeCompare
  , replace
  , replaceAll
  , take
  , takeRight
  , takeWhile
  , drop
  , dropRight
  , dropWhile
  , slice
  , stripPrefix
  , stripSuffix
  , count
  , split
  , splitAt
  , toCharArray
  , toLower
  , toUpper
  , trim
  , joinWith
  ) where

import Prelude

import Data.Maybe (Maybe(..), isJust)
import Data.Newtype (class Newtype)
import Data.String.Unsafe as U

-- | A newtype used in cases where there is a string to be matched.
-- |
-- | ```purescript
-- | pursPattern = Pattern ".purs"
-- | --can be used like this:
-- | contains pursPattern "Test.purs"
-- |    == true
-- | ```
-- |
newtype Pattern = Pattern String

derive instance eqPattern :: Eq Pattern
derive instance ordPattern :: Ord Pattern
derive instance newtypePattern :: Newtype Pattern _

instance showPattern :: Show Pattern where
  show (Pattern s) = "(Pattern " <> show s <> ")"

-- | A newtype used in cases to specify a replacement for a pattern.
newtype Replacement = Replacement String

derive instance eqReplacement :: Eq Replacement
derive instance ordReplacement :: Ord Replacement
derive instance newtypeReplacement :: Newtype Replacement _

instance showReplacement :: Show Replacement where
  show (Replacement s) = "(Replacement " <> show s <> ")"

-- | Returns the character at the given index, if the index is within bounds.
-- |
-- | ```purescript
-- | charAt 2 "Hello" == Just 'l'
-- | charAt 10 "Hello" == Nothing
-- | ```
-- |
charAt :: Int -> String -> Maybe Char
charAt = _charAt Just Nothing

foreign import _charAt
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Int
  -> String
  -> Maybe Char

-- | Returns a string of length `1` containing the given character.
-- |
-- | ```purescript
-- | singleton 'l' == "l"
-- | ```
-- |
foreign import singleton :: Char -> String

-- | Returns the numeric Unicode value of the character at the given index,
-- | if the index is within bounds.
-- | ```purescript
-- | charCodeAt 2 "5 €" == Just 0x20AC
-- | charCodeAt 10 "5 €" == Nothing
-- | ```
-- |
charCodeAt :: Int -> String -> Maybe Int
charCodeAt = _charCodeAt Just Nothing

foreign import _charCodeAt
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Converts the string to a character, if the length of the string is
-- | exactly `1`.
-- |
-- | ```purescript
-- | toChar "l" == Just 'l'
-- | toChar "Hi" == Nothing -- since length is not 1
-- | ```
-- |
toChar :: String -> Maybe Char
toChar = _toChar Just Nothing

foreign import _toChar
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> String
  -> Maybe Char

-- | Returns `true` if the given string is empty.
-- |
-- | ```purescript
-- | null "" == true
-- | null "Hi" == false
-- | ```
-- |
null :: String -> Boolean
null s = s == ""

-- | Returns the first character and the rest of the string,
-- | if the string is not empty.
-- |
-- | ```purescript
-- | uncons "" == Nothing
-- | uncons "Hello World" == Just { head: 'H', tail: "ello World" }
-- | ```
-- |
uncons :: String -> Maybe { head :: Char, tail :: String }
uncons "" = Nothing
uncons s  = Just { head: U.charAt zero s, tail: drop one s }

-- | Returns the longest prefix (possibly empty) of characters that satisfy
-- | the predicate.
-- |
-- | ```purescript
-- | takeWhile (_ /= ':') "http://purescript.org" == "http"
-- | ```
-- |
takeWhile :: (Char -> Boolean) -> String -> String
takeWhile p s = take (count p s) s

-- | Returns the suffix remaining after `takeWhile`.
-- |
-- | ```purescript
-- | dropWhile (_ /= '.') "Test.purs" == ".purs"
-- | ```
-- |
dropWhile :: (Char -> Boolean) -> String -> String
dropWhile p s = drop (count p s) s

-- | Returns the substring at indices [begin, end).
-- | If either index is negative, it is normalised to `length s - index`,
-- | where `s` is the input string. An empty string is returned if either
-- | index is out of bounds or if `begin > end` after normalisation.
-- |
-- | ```purescript
-- | slice 0 1 "purescript" == "p"
-- | slice 3 6 "purescript" == "ecr"
-- | slice -4 -1 "purescript" == "rip"
foreign import slice :: Int -> Int -> String -> String

-- | If the string starts with the given prefix, return the portion of the
-- | string left after removing it, as a Just value. Otherwise, return Nothing.
-- |
-- | ```purescript
-- | stripPrefix (Pattern "http:") "http://purescript.org" == Just "//purescript.org"
-- | stripPrefix (Pattern "http:") "https://purescript.org" == Nothing
-- | ```
-- |
stripPrefix :: Pattern -> String -> Maybe String
stripPrefix prefix@(Pattern prefixS) str =
  case indexOf prefix str of
    Just 0 -> Just $ drop (length prefixS) str
    _ -> Nothing

-- | If the string ends with the given suffix, return the portion of the
-- | string left after removing it, as a `Just` value. Otherwise, return
-- | `Nothing`.
-- |
-- | ```purescript
-- | stripSuffix (Pattern ".exe") "psc.exe" == Just "psc"
-- | stripSuffix (Pattern ".exe") "psc" == Nothing
-- | ```
-- |
stripSuffix :: Pattern -> String -> Maybe String
stripSuffix suffix@(Pattern suffixS) str =
  case lastIndexOf suffix str of
    Just x | x == length str - length suffixS -> Just $ take x str
    _ -> Nothing

-- | Converts an array of characters into a string.
-- |
-- | ```purescript
-- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello"
-- | ```
-- |
foreign import fromCharArray :: Array Char -> String

-- | Checks whether the pattern appears in the given string.
-- |
-- | ```purescript
-- | contains (Pattern "needle") "haystack with needle" == true
-- | contains (Pattern "needle") "haystack" == false
-- | ```
-- |
contains :: Pattern -> String -> Boolean
contains pat = isJust <<< indexOf pat

-- | Returns the index of the first occurrence of the pattern in the
-- | given string. Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | indexOf (Pattern "c") "abcdc" == Just 2
-- | indexOf (Pattern "c") "aaa" == Nothing
-- | ```
-- |
indexOf :: Pattern -> String -> Maybe Int
indexOf = _indexOf Just Nothing

foreign import _indexOf
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> String
  -> Maybe Int

-- | Returns the index of the first occurrence of the pattern in the
-- | given string, starting at the specified index. Returns `Nothing` if there is
-- | no match.
-- |
-- | ```purescript
-- | indexOf' (Pattern "a") 2 "ababa" == Just 2
-- | indexOf' (Pattern "a") 3 "ababa" == Just 4
-- | ```
-- |
indexOf' :: Pattern -> Int -> String -> Maybe Int
indexOf' = _indexOf' Just Nothing

foreign import _indexOf'
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> Int
  -> String
  -> Maybe Int

-- | Returns the index of the last occurrence of the pattern in the
-- | given string. Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | lastIndexOf (Pattern "c") "abcdc" == Just 4
-- | lastIndexOf (Pattern "c") "aaa" == Nothing
-- | ```
-- |
lastIndexOf :: Pattern -> String -> Maybe Int
lastIndexOf = _lastIndexOf Just Nothing

foreign import _lastIndexOf
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> String
  -> Maybe Int

-- | Returns the index of the last occurrence of the pattern in the
-- | given string, starting at the specified index
-- | and searching backwards towards the beginning of the string.
-- | Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | lastIndexOf' (Pattern "a") 1 "ababa" == Just 0
-- | lastIndexOf' (Pattern "a") 3 "ababa" == Just 2
-- | lastIndexOf' (Pattern "a") 4 "ababa" == Just 4
-- | ```
-- |
lastIndexOf' :: Pattern -> Int -> String -> Maybe Int
lastIndexOf' = _lastIndexOf' Just Nothing

foreign import _lastIndexOf'
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> Int
  -> String
  -> Maybe Int

-- | Returns the number of characters the string is composed of.
-- |
-- | ```purescript
-- | length "Hello World" == 11
-- | ```
-- |
foreign import length :: String -> Int

-- | Compare two strings in a locale-aware fashion. This is in contrast to
-- | the `Ord` instance on `String` which treats strings as arrays of code
-- | units:
-- |
-- | ```purescript
-- | "ä" `localeCompare` "b" == LT
-- | "ä" `compare` "b" == GT
-- | ```
-- |
localeCompare :: String -> String -> Ordering
localeCompare = _localeCompare LT EQ GT

foreign import _localeCompare
  :: Ordering
  -> Ordering
  -> Ordering
  -> String
  -> String
  -> Ordering

-- | Replaces the first occurence of the pattern with the replacement string.
-- |
-- | ```purescript
-- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c"
-- | ```
-- |
foreign import replace :: Pattern -> Replacement -> String -> String

-- | Replaces all occurences of the pattern with the replacement string.
-- |
-- | ```purescript
-- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c"
-- | ```
-- |
foreign import replaceAll :: Pattern -> Replacement -> String -> String

-- | Returns the first `n` characters of the string.
-- |
-- | ```purescript
-- | take 5 "Hello World" == "Hello"
-- | ```
-- |
foreign import take :: Int -> String -> String

-- | Returns the last `n` characters of the string.
-- |
-- | ```purescript
-- | takeRight 5 "Hello World" == "World"
-- | ```
-- |
takeRight :: Int -> String -> String
takeRight i s = drop (length s - i) s

-- | Returns the string without the first `n` characters.
-- |
-- | ```purescript
-- | drop 6 "Hello World" == "World"
-- | ```
-- |
foreign import drop :: Int -> String -> String

-- | Returns the string without the last `n` characters.
-- |
-- | ```purescript
-- | dropRight 6 "Hello World" == "Hello"
-- | ```
-- |
dropRight :: Int -> String -> String
dropRight i s = take (length s - i) s

-- | Returns the number of contiguous characters at the beginning
-- | of the string for which the predicate holds.
-- |
-- | ```purescript
-- | count (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5
-- | ```
-- |
foreign import count :: (Char -> Boolean) -> String -> Int

-- | Returns the substrings of the second string separated along occurences
-- | of the first string.
-- |
-- | ```purescript
-- | split (Pattern " ") "hello world" == ["hello", "world"]
-- | ```
-- |
foreign import split :: Pattern -> String -> Array String

-- | Returns the substrings of a split at the given index, if the index is within bounds.
-- |
-- | ```purescript
-- | splitAt 2 "Hello World" == Just { before: "He", after: "llo World"}
-- | splitAt 10 "Hi" == Nothing
-- | ```
-- |
splitAt :: Int -> String -> Maybe { before :: String, after :: String }
splitAt = _splitAt Just Nothing

foreign import _splitAt :: (forall a. a -> Maybe a)
                        -> (forall a. Maybe a)
                        -> Int
                        -> String
                        -> Maybe { before :: String, after :: String }

-- | Converts the string into an array of characters.
-- |
-- | ```purescript
-- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n']
-- | ```
-- |
foreign import toCharArray :: String -> Array Char

-- | Returns the argument converted to lowercase.
-- |
-- | ```purescript
-- | toLower "hElLo" == "hello"
-- | ```
-- |
foreign import toLower :: String -> String

-- | Returns the argument converted to uppercase.
-- |
-- | ```purescript
-- | toUpper "Hello" == "HELLO"
-- | ```
-- |
foreign import toUpper :: String -> String

-- | Removes whitespace from the beginning and end of a string, including
-- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2)
-- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3).
-- |
-- | ```purescript
-- | trim "   Hello  \n World\n\t    " == "Hello  \n World"
-- | ```
-- |
foreign import trim :: String -> String

-- | Joins the strings in the array together, inserting the first argument
-- | as separator between them.
-- |
-- | ```purescript
-- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange"
-- | ```
-- |
foreign import joinWith :: String -> Array String -> String

-- | Wraps the functions of Javascript's `String` object.
-- | A String represents a sequence of characters.
-- | For details of the underlying implementation, see [String Reference at MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String).
module Data.String
  ( Pattern(..)
  , Replacement(..)
  , charAt
  , charCodeAt
  , fromCharArray
  , toChar
  , contains
  , indexOf
  , indexOf'
  , lastIndexOf
  , lastIndexOf'
  , null
  , uncons
  , length
  , singleton
  , localeCompare
  , replace
  , replaceAll
  , take
  , takeRight
  , takeWhile
  , drop
  , dropRight
  , dropWhile
  , slice
  , stripPrefix
  , stripSuffix
  , count
  , split
  , splitAt
  , toCharArray
  , toLower
  , toUpper
  , trim
  , joinWith
  ) where

import Prelude

import Data.Maybe (Maybe(..), isJust)
import Data.Newtype (class Newtype)
import Data.String.Unsafe as U

-- | A newtype used in cases where there is a string to be matched.
-- |
-- | ```purescript
-- | pursPattern = Pattern ".purs"
-- | --can be used like this:
-- | contains pursPattern "Test.purs"
-- |    == true
-- | ```
-- |
newtype Pattern = Pattern String

derive instance eqPattern :: Eq Pattern
derive instance ordPattern :: Ord Pattern
derive instance newtypePattern :: Newtype Pattern _

instance showPattern :: Show Pattern where
  show (Pattern s) = "(Pattern " <> show s <> ")"

-- | A newtype used in cases to specify a replacement for a pattern.
newtype Replacement = Replacement String

derive instance eqReplacement :: Eq Replacement
derive instance ordReplacement :: Ord Replacement
derive instance newtypeReplacement :: Newtype Replacement _

instance showReplacement :: Show Replacement where
  show (Replacement s) = "(Replacement " <> show s <> ")"

-- | Returns the character at the given index, if the index is within bounds.
-- |
-- | ```purescript
-- | charAt 2 "Hello" == Just 'l'
-- | charAt 10 "Hello" == Nothing
-- | ```
-- |
charAt :: Int -> String -> Maybe Char
charAt = _charAt Just Nothing

foreign import _charAt
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Int
  -> String
  -> Maybe Char

-- | Returns a string of length `1` containing the given character.
-- |
-- | ```purescript
-- | singleton 'l' == "l"
-- | ```
-- |
foreign import singleton :: Char -> String

-- | Returns the numeric Unicode value of the character at the given index,
-- | if the index is within bounds.
-- | ```purescript
-- | charCodeAt 2 "5 €" == Just 0x20AC
-- | charCodeAt 10 "5 €" == Nothing
-- | ```
-- |
charCodeAt :: Int -> String -> Maybe Int
charCodeAt = _charCodeAt Just Nothing

foreign import _charCodeAt
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Converts the string to a character, if the length of the string is
-- | exactly `1`.
-- |
-- | ```purescript
-- | toChar "l" == Just 'l'
-- | toChar "Hi" == Nothing -- since length is not 1
-- | ```
-- |
toChar :: String -> Maybe Char
toChar = _toChar Just Nothing

foreign import _toChar
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> String
  -> Maybe Char

-- | Returns `true` if the given string is empty.
-- |
-- | ```purescript
-- | null "" == true
-- | null "Hi" == false
-- | ```
-- |
null :: String -> Boolean
null s = s == ""

-- | Returns the first character and the rest of the string,
-- | if the string is not empty.
-- |
-- | ```purescript
-- | uncons "" == Nothing
-- | uncons "Hello World" == Just { head: 'H', tail: "ello World" }
-- | ```
-- |
uncons :: String -> Maybe { head :: Char, tail :: String }
uncons "" = Nothing
uncons s  = Just { head: U.charAt zero s, tail: drop one s }

-- | Returns the longest prefix (possibly empty) of characters that satisfy
-- | the predicate.
-- |
-- | ```purescript
-- | takeWhile (_ /= ':') "http://purescript.org" == "http"
-- | ```
-- |
takeWhile :: (Char -> Boolean) -> String -> String
takeWhile p s = take (count p s) s

-- | Returns the suffix remaining after `takeWhile`.
-- |
-- | ```purescript
-- | dropWhile (_ /= '.') "Test.purs" == ".purs"
-- | ```
-- |
dropWhile :: (Char -> Boolean) -> String -> String
dropWhile p s = drop (count p s) s

-- | Returns the substring at indices [begin, end).
-- | If either index is negative, it is normalized to `length s - index`,
-- | where `s` is the input string. An empty string is returned if either
-- | index is out of bounds or if `begin > end`.
-- |
-- | ```purescript
-- | slice 0 1 "purescript" == "p"
-- | slice 3 6 "purescript" == "ecr"
-- | slice -4 -1 "purescript" == "rip"
foreign import slice :: Int -> Int -> String -> String

-- | If the string starts with the given prefix, return the portion of the
-- | string left after removing it, as a Just value. Otherwise, return Nothing.
-- |
-- | ```purescript
-- | stripPrefix (Pattern "http:") "http://purescript.org" == Just "//purescript.org"
-- | stripPrefix (Pattern "http:") "https://purescript.org" == Nothing
-- | ```
-- |
stripPrefix :: Pattern -> String -> Maybe String
stripPrefix prefix@(Pattern prefixS) str =
  case indexOf prefix str of
    Just 0 -> Just $ drop (length prefixS) str
    _ -> Nothing

-- | If the string ends with the given suffix, return the portion of the
-- | string left after removing it, as a `Just` value. Otherwise, return
-- | `Nothing`.
-- |
-- | ```purescript
-- | stripSuffix (Pattern ".exe") "psc.exe" == Just "psc"
-- | stripSuffix (Pattern ".exe") "psc" == Nothing
-- | ```
-- |
stripSuffix :: Pattern -> String -> Maybe String
stripSuffix suffix@(Pattern suffixS) str =
  case lastIndexOf suffix str of
    Just x | x == length str - length suffixS -> Just $ take x str
    _ -> Nothing

-- | Converts an array of characters into a string.
-- |
-- | ```purescript
-- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == "Hello"
-- | ```
-- |
foreign import fromCharArray :: Array Char -> String

-- | Checks whether the pattern appears in the given string.
-- |
-- | ```purescript
-- | contains (Pattern "needle") "haystack with needle" == true
-- | contains (Pattern "needle") "haystack" == false
-- | ```
-- |
contains :: Pattern -> String -> Boolean
contains pat = isJust <<< indexOf pat

-- | Returns the index of the first occurrence of the pattern in the
-- | given string. Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | indexOf (Pattern "c") "abcdc" == Just 2
-- | indexOf (Pattern "c") "aaa" == Nothing
-- | ```
-- |
indexOf :: Pattern -> String -> Maybe Int
indexOf = _indexOf Just Nothing

foreign import _indexOf
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> String
  -> Maybe Int

-- | Returns the index of the first occurrence of the pattern in the
-- | given string, starting at the specified index. Returns `Nothing` if there is
-- | no match.
-- |
-- | ```purescript
-- | indexOf' (Pattern "a") 2 "ababa" == Just 2
-- | indexOf' (Pattern "a") 3 "ababa" == Just 4
-- | ```
-- |
indexOf' :: Pattern -> Int -> String -> Maybe Int
indexOf' = _indexOf' Just Nothing

foreign import _indexOf'
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> Int
  -> String
  -> Maybe Int

-- | Returns the index of the last occurrence of the pattern in the
-- | given string. Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | lastIndexOf (Pattern "c") "abcdc" == Just 4
-- | lastIndexOf (Pattern "c") "aaa" == Nothing
-- | ```
-- |
lastIndexOf :: Pattern -> String -> Maybe Int
lastIndexOf = _lastIndexOf Just Nothing

foreign import _lastIndexOf
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> String
  -> Maybe Int

-- | Returns the index of the last occurrence of the pattern in the
-- | given string, starting at the specified index
-- | and searching backwards towards the beginning of the string.
-- | Returns `Nothing` if there is no match.
-- |
-- | ```purescript
-- | lastIndexOf' (Pattern "a") 1 "ababa" == Just 0
-- | lastIndexOf' (Pattern "a") 3 "ababa" == Just 2
-- | lastIndexOf' (Pattern "a") 4 "ababa" == Just 4
-- | ```
-- |
lastIndexOf' :: Pattern -> Int -> String -> Maybe Int
lastIndexOf' = _lastIndexOf' Just Nothing

foreign import _lastIndexOf'
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Pattern
  -> Int
  -> String
  -> Maybe Int

-- | Returns the number of characters the string is composed of.
-- |
-- | ```purescript
-- | length "Hello World" == 11
-- | ```
-- |
foreign import length :: String -> Int

-- | Compare two strings in a locale-aware fashion. This is in contrast to
-- | the `Ord` instance on `String` which treats strings as arrays of code
-- | units:
-- |
-- | ```purescript
-- | "ä" `localeCompare` "b" == LT
-- | "ä" `compare` "b" == GT
-- | ```
-- |
localeCompare :: String -> String -> Ordering
localeCompare = _localeCompare LT EQ GT

foreign import _localeCompare
  :: Ordering
  -> Ordering
  -> Ordering
  -> String
  -> String
  -> Ordering

-- | Replaces the first occurence of the pattern with the replacement string.
-- |
-- | ```purescript
-- | replace (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b <= c"
-- | ```
-- |
foreign import replace :: Pattern -> Replacement -> String -> String

-- | Replaces all occurences of the pattern with the replacement string.
-- |
-- | ```purescript
-- | replaceAll (Pattern "<=") (Replacement "≤") "a <= b <= c" == "a ≤ b ≤ c"
-- | ```
-- |
foreign import replaceAll :: Pattern -> Replacement -> String -> String

-- | Returns the first `n` characters of the string.
-- |
-- | ```purescript
-- | take 5 "Hello World" == "Hello"
-- | ```
-- |
foreign import take :: Int -> String -> String

-- | Returns the last `n` characters of the string.
-- |
-- | ```purescript
-- | takeRight 5 "Hello World" == "World"
-- | ```
-- |
takeRight :: Int -> String -> String
takeRight i s = drop (length s - i) s

-- | Returns the string without the first `n` characters.
-- |
-- | ```purescript
-- | drop 6 "Hello World" == "World"
-- | ```
-- |
foreign import drop :: Int -> String -> String

-- | Returns the string without the last `n` characters.
-- |
-- | ```purescript
-- | dropRight 6 "Hello World" == "Hello"
-- | ```
-- |
dropRight :: Int -> String -> String
dropRight i s = take (length s - i) s

-- | Returns the number of contiguous characters at the beginning
-- | of the string for which the predicate holds.
-- |
-- | ```purescript
-- | count (_ /= ' ') "Hello World" == 5 -- since length "Hello" == 5
-- | ```
-- |
foreign import count :: (Char -> Boolean) -> String -> Int

-- | Returns the substrings of the second string separated along occurences
-- | of the first string.
-- |
-- | ```purescript
-- | split (Pattern " ") "hello world" == ["hello", "world"]
-- | ```
-- |
foreign import split :: Pattern -> String -> Array String

-- | Returns the substrings of a split at the given index, if the index is within bounds.
-- |
-- | ```purescript
-- | splitAt 2 "Hello World" == Just { before: "He", after: "llo World"}
-- | splitAt 10 "Hi" == Nothing
-- | ```
-- |
splitAt :: Int -> String -> Maybe { before :: String, after :: String }
splitAt = _splitAt Just Nothing

foreign import _splitAt :: (forall a. a -> Maybe a)
                        -> (forall a. Maybe a)
                        -> Int
                        -> String
                        -> Maybe { before :: String, after :: String }

-- | Converts the string into an array of characters.
-- |
-- | ```purescript
-- | toCharArray "Hello☺\n" == ['H','e','l','l','o','☺','\n']
-- | ```
-- |
foreign import toCharArray :: String -> Array Char

-- | Returns the argument converted to lowercase.
-- |
-- | ```purescript
-- | toLower "hElLo" == "hello"
-- | ```
-- |
foreign import toLower :: String -> String

-- | Returns the argument converted to uppercase.
-- |
-- | ```purescript
-- | toUpper "Hello" == "HELLO"
-- | ```
-- |
foreign import toUpper :: String -> String

-- | Removes whitespace from the beginning and end of a string, including
-- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2)
-- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3).
-- |
-- | ```purescript
-- | trim "   Hello  \n World\n\t    " == "Hello  \n World"
-- | ```
-- |
foreign import trim :: String -> String

-- | Joins the strings in the array together, inserting the first argument
-- | as separator between them.
-- |
-- | ```purescript
-- | joinWith ", " ["apple", "banana", "orange"] == "apple, banana, orange"
-- | ```
-- |
foreign import joinWith :: String -> Array String -> String


Remove unnecessary local definition of `asTypeOf`

module Test.QuickCheck.Classes where

import Test.QuickCheck (QC(..), Arb, quickCheck)

-- |
-- Functor
--

checkFunctor :: forall f a. (Functor f, Arb a, Arb (a -> a), Arb (f a), Eq (f a), Show a, Show (a -> a), Show (f a)) => f a -> QC
checkFunctor t = do
  quickCheck $ identity t
  quickCheck $ associativity t

  where

  identity :: forall f a. (Functor f, Arb a, Eq (f a)) => f a -> f a -> Boolean
  identity _ f = id <$> f == id f

  associativity :: forall f a. (Functor f, Arb a, Eq (f a)) => f a -> f a -> (a -> a) -> (a -> a) -> Boolean
  associativity _ f p q = (p <<< q) <$> f == ((<$>) p <<< (<$>) q) f

-- |
-- Applicative
--

checkApplicative :: forall f a b c. (Applicative f, Show (f a), Show (f (a -> b)), Show (f (b -> c)), Show (a -> b), Show a, Arb (f a), Arb (f (a -> b)), Arb (f (b -> c)), Arb (a -> b), Arb a, Eq (f a), Eq (f b), Eq (f c)) => f a -> f b -> f c -> QC
checkApplicative ta tb tc = do
  quickCheck $ identity ta
  quickCheck $ composition ta tb tc
  quickCheck $ homomorphism ta tb
  quickCheck $ interchange ta tb

  where

  identity :: forall f a. (Applicative f, Arb (f a), Eq (f a)) => f a -> f a -> Boolean
  identity _ v = (pure id <*> v) == v

  composition :: forall f a b c. (Applicative f, Arb (f (b -> c)), Arb (f (a -> b)), Arb (f a), Eq (f c)) => f a -> f b -> f c -> f (b -> c) -> f (a -> b) -> f a -> Boolean
  composition _ _ _ u v w = (pure (<<<) <*> u <*> v <*> w) == (u <*> (v <*> w))

  homomorphism :: forall f a b. (Applicative f, Arb (a -> b), Arb a, Eq (f b)) => f a -> f b -> (a -> b) -> a -> Boolean
  homomorphism _ tb f x = (pure f <*> pure x) == (pure (f x) `asTypeOf` tb)

  interchange :: forall f a b. (Applicative f, Arb a, Arb (f (a -> b)), Eq (f b)) => f a -> f b -> a -> f (a -> b) -> Boolean
  interchange _ _ y u = (u <*> pure y) == (pure (\x -> x y) <*> u)

-- |
-- Monad
--

checkMonad :: forall m a. (Monad m, Arb a, Arb (a -> m a), Arb (m a), Eq (m a), Show a, Show (a -> m a), Show (m a)) => m a -> QC
checkMonad t = do
  quickCheck $ leftIdentity t
  quickCheck $ rightIdentity t
  quickCheck $ associativity t

  where

  leftIdentity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> a -> (a -> m a) -> Boolean
  leftIdentity _ x f = (return x >>= f) == (f x)

  rightIdentity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> m a -> Boolean
  rightIdentity _ m = (m >>= return) == m

  associativity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> m a -> (a -> m a) -> (a -> m a) -> Boolean
  associativity _ m f g = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g))

module Test.QuickCheck.Classes where

import Test.QuickCheck (QC(..), Arb, quickCheck)

-- |
-- Functor
--

checkFunctor :: forall f a. (Functor f, Arb a, Arb (a -> a), Arb (f a), Eq (f a), Show a, Show (a -> a), Show (f a)) => f a -> QC
checkFunctor t = do
  quickCheck $ identity t
  quickCheck $ associativity t

  where

  identity :: forall f a. (Functor f, Arb a, Eq (f a)) => f a -> f a -> Boolean
  identity _ f = id <$> f == id f

  associativity :: forall f a. (Functor f, Arb a, Eq (f a)) => f a -> f a -> (a -> a) -> (a -> a) -> Boolean
  associativity _ f p q = (p <<< q) <$> f == ((<$>) p <<< (<$>) q) f

-- |
-- Applicative
--

checkApplicative :: forall f a b c. (Applicative f, Show (f a), Show (f (a -> b)), Show (f (b -> c)), Show (a -> b), Show a, Arb (f a), Arb (f (a -> b)), Arb (f (b -> c)), Arb (a -> b), Arb a, Eq (f a), Eq (f b), Eq (f c)) => f a -> f b -> f c -> QC
checkApplicative ta tb tc = do
  quickCheck $ identity ta
  quickCheck $ composition ta tb tc
  quickCheck $ homomorphism ta tb
  quickCheck $ interchange ta tb

  where

  identity :: forall f a. (Applicative f, Arb (f a), Eq (f a)) => f a -> f a -> Boolean
  identity _ v = (pure id <*> v) == v

  composition :: forall f a b c. (Applicative f, Arb (f (b -> c)), Arb (f (a -> b)), Arb (f a), Eq (f c)) => f a -> f b -> f c -> f (b -> c) -> f (a -> b) -> f a -> Boolean
  composition _ _ _ u v w = (pure (<<<) <*> u <*> v <*> w) == (u <*> (v <*> w))

  homomorphism :: forall f a b. (Applicative f, Arb (a -> b), Arb a, Eq (f b)) => f a -> f b -> (a -> b) -> a -> Boolean
  homomorphism _ tb f x = (pure f <*> pure x) == (pure (f x) `asTypeOf` tb)
    where
    asTypeOf :: forall a. a -> a -> a
    asTypeOf x _ = x

  interchange :: forall f a b. (Applicative f, Arb a, Arb (f (a -> b)), Eq (f b)) => f a -> f b -> a -> f (a -> b) -> Boolean
  interchange _ _ y u = (u <*> pure y) == (pure (\x -> x y) <*> u)

-- |
-- Monad
--

checkMonad :: forall m a. (Monad m, Arb a, Arb (a -> m a), Arb (m a), Eq (m a), Show a, Show (a -> m a), Show (m a)) => m a -> QC
checkMonad t = do
  quickCheck $ leftIdentity t
  quickCheck $ rightIdentity t
  quickCheck $ associativity t

  where

  leftIdentity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> a -> (a -> m a) -> Boolean
  leftIdentity _ x f = (return x >>= f) == (f x)

  rightIdentity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> m a -> Boolean
  rightIdentity _ m = (m >>= return) == m

  associativity :: forall m a. (Monad m, Arb a, Eq (m a)) => m a -> m a -> (a -> m a) -> (a -> m a) -> Boolean
  associativity _ m f g = ((m >>= f) >>= g) == (m >>= (\x -> f x >>= g))


Fixed broken icons paths (#1284)

Fixed broken icons paths (#1284)

{-
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 SlamData.Config where

import Prelude ((<>))
import Data.Time.Duration (Milliseconds(Milliseconds))

baseUrl :: String
baseUrl = ""

browserUrl :: String
browserUrl = baseUrl <> "index.html"

workspaceUrl :: String
workspaceUrl = baseUrl <> "workspace.html"

darkIconsPath ∷ String
darkIconsPath = "img/cardsDark"

lightIconsPath ∷ String
lightIconsPath = "img/cardsLight"

searchTimeout :: Number
searchTimeout = 500.0

slamDataHome :: String
slamDataHome = baseUrl <> "index.html"

userEnabled :: Boolean
userEnabled = false

newFolderName :: String
newFolderName = "Untitled Folder"

folderMark :: String
folderMark = ".folder"

workspaceExtension :: String
workspaceExtension = "slam"

newWorkspaceName :: String
newWorkspaceName = "Untitled Workspace"

newFileName :: String
newFileName = "Untitled File"

newDatabaseName :: String
newDatabaseName = "Untitled Database"

newViewMountName :: String
newViewMountName = "Untitled View"

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

workspaceNameEditorId :: String
workspaceNameEditorId = "name-editor"

defaultPageSize :: Int
defaultPageSize = 10

notifyTimeout :: Int
notifyTimeout = 500

authenticationTimeout :: Int
authenticationTimeout = 5000

resizeEChartsTimeout :: Int
resizeEChartsTimeout = 0

addCardGuideDelay :: Milliseconds
addCardGuideDelay = Milliseconds 4000.0

trashFolder :: String
trashFolder = ".trash"

tickTick :: Int
tickTick = 1000

autosaveTick :: Int
autosaveTick = 1000

redirectURIString :: String
redirectURIString = "/auth_redirect.html"

isSharingPermissionReady :: Boolean
isSharingPermissionReady = true

{-
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 SlamData.Config where

import Prelude ((<>))
import Data.Time.Duration (Milliseconds(Milliseconds))

baseUrl :: String
baseUrl = ""

browserUrl :: String
browserUrl = baseUrl <> "index.html"

workspaceUrl :: String
workspaceUrl = baseUrl <> "workspace.html"

darkIconsPath ∷ String
darkIconsPath = "img/iconsDark"

lightIconsPath ∷ String
lightIconsPath = "img/iconsLight"

searchTimeout :: Number
searchTimeout = 500.0

slamDataHome :: String
slamDataHome = baseUrl <> "index.html"

userEnabled :: Boolean
userEnabled = false

newFolderName :: String
newFolderName = "Untitled Folder"

folderMark :: String
folderMark = ".folder"

workspaceExtension :: String
workspaceExtension = "slam"

newWorkspaceName :: String
newWorkspaceName = "Untitled Workspace"

newFileName :: String
newFileName = "Untitled File"

newDatabaseName :: String
newDatabaseName = "Untitled Database"

newViewMountName :: String
newViewMountName = "Untitled View"

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

workspaceNameEditorId :: String
workspaceNameEditorId = "name-editor"

defaultPageSize :: Int
defaultPageSize = 10

notifyTimeout :: Int
notifyTimeout = 500

authenticationTimeout :: Int
authenticationTimeout = 5000

resizeEChartsTimeout :: Int
resizeEChartsTimeout = 0

addCardGuideDelay :: Milliseconds
addCardGuideDelay = Milliseconds 4000.0

trashFolder :: String
trashFolder = ".trash"

tickTick :: Int
tickTick = 1000

autosaveTick :: Int
autosaveTick = 1000

redirectURIString :: String
redirectURIString = "/auth_redirect.html"

isSharingPermissionReady :: Boolean
isSharingPermissionReady = true


Better reporting abilities for pure quickCheck runs

-- | This module is a partial port of the Haskell QuickCheck library.
-- |
-- | QuickCheck provides a way to write _property-based_ tests.
-- |
-- | The `Arbitrary` and `CoArbitrary` type classes allow us to create
-- | random data with which we can run our tests. This module provides
-- | instances of both classes for PureScript's core data structures,
-- | as well as functions for writing new instances.
-- |
-- | Test suites can use the `quickCheck` and `quickCheckPure` functions
-- | to test properties.
-- |
-- | For example:
-- |
-- | ```purescript
-- | main = quickCheck \n -> n + 1 > n
-- | ```
module Test.QuickCheck
  ( quickCheck
  , quickCheckGen
  , quickCheck'
  , quickCheckGen'
  , quickCheckWithSeed
  , quickCheckGenWithSeed
  , quickCheckPure
  , quickCheckPure'
  , quickCheckGenPure
  , quickCheckGenPure'
  , ResultSummary
  , checkResults
  , printSummary
  , class Testable
  , test
  , Result(..)
  , withHelp
  , (<?>)
  , assertEquals
  , (===)
  , (==?)
  , assertNotEquals
  , (/==)
  , (/=?)
  , assertLessThan
  , (<?)
  , assertLessThanEq
  , (<=?)
  , assertGreaterThan
  , (>?)
  , assertGreaterThanEq
  , (>=?)
  , module Random.LCG
  , module Test.QuickCheck.Arbitrary
  ) where

import Prelude

import Control.Monad.Rec.Class (Step(..), tailRec)
import Data.Foldable (for_)
import Data.FoldableWithIndex (foldlWithIndex)
import Data.List (List)
import Data.List as List
import Data.Maybe (Maybe(..))
import Data.Maybe.First (First(..))
import Data.Tuple (Tuple(..))
import Data.Unfoldable (replicateA)
import Effect (Effect)
import Effect.Console (log)
import Effect.Exception (throwException, error)
import Random.LCG (Seed, mkSeed, unSeed, randomSeed)
import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
import Test.QuickCheck.Gen (Gen, evalGen, runGen, stateful)

-- | Test a property.
-- |
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall prop. Testable prop => prop -> Effect Unit
quickCheck prop = quickCheck' 100 prop

-- | A version of `quickCheck` with the property specialized to `Gen`.
-- |
-- | The `quickCheckGen` variants are useful for writing property tests where a
-- | `MonadGen` constraint (or QuickCheck's `Gen` directly) is being used,
-- | rather than relying on `Arbitrary` instances. Especially useful for the
-- | `MonadGen`-constrained properties as they will not infer correctly when
-- | used with the `quickCheck` functions unless an explicit type annotation is
-- | used.
quickCheckGen :: forall prop. Testable prop => Gen prop -> Effect Unit
quickCheckGen = quickCheck

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
quickCheck' :: forall prop. Testable prop => Int -> prop -> Effect Unit
quickCheck' n prop = do
  seed <- randomSeed
  quickCheckWithSeed seed n prop

-- | A version of `quickCheck'` with the property specialized to `Gen`.
quickCheckGen' :: forall prop. Testable prop => Int -> Gen prop -> Effect Unit
quickCheckGen' = quickCheck'

-- | A variant of the `quickCheck'` function that accepts a specific seed as
-- | well as the number tests that should be run.
quickCheckWithSeed
  :: forall prop. Testable prop => Seed -> Int -> prop -> Effect Unit
quickCheckWithSeed initialSeed n prop = do
  let result = tailRec loop { seed: initialSeed, index: 0, successes: 0, firstFailure: mempty }
  log $ show result.successes <> "/" <> show n <> " test(s) passed."
  for_ result.firstFailure \{ index, message, seed: failureSeed } ->
    throwException $ error
      $ "Test " <> show (index + 1)
      <> " (seed " <> show (unSeed failureSeed) <> ") failed: \n"
      <> message
  where
  loop :: LoopState -> Step LoopState LoopState
  loop state@{ seed, index, successes, firstFailure }
    | index == n = Done state
    | otherwise =
        case runGen (test prop) { newSeed: seed, size: 10 } of
          Tuple Success s ->
            Loop
              { seed: s.newSeed
              , index: index + 1
              , successes: successes + 1
              , firstFailure
              }
          Tuple (Failed message) s ->
            Loop
              { seed: s.newSeed
              , index: index + 1
              , successes
              , firstFailure:
                  firstFailure <> First (Just { index, message, seed })
              }

-- | A version of `quickCheckWithSeed` with the property specialized to `Gen`.
quickCheckGenWithSeed :: forall prop. Testable prop => Seed -> Int -> Gen prop -> Effect Unit
quickCheckGenWithSeed = quickCheckWithSeed

type LoopState =
  { successes :: Int
  , firstFailure :: First { index :: Int, message :: String, seed :: Seed }
  , seed :: Seed
  , index :: Int
  }

-- | Test a property, returning all test results as a List.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure :: forall prop. Testable prop => Seed -> Int -> prop -> List Result
quickCheckPure s n prop = evalGen (replicateA n (test prop)) { newSeed: s, size: 10 }

-- | Test a property, returning all test results as a List, with the Seed that
-- | was used for each result.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure' :: forall prop. Testable prop => Seed -> Int -> prop -> List (Tuple Seed Result)
quickCheckPure' s n prop = evalGen (replicateA n (go prop)) { newSeed: s, size: 10 }
  where
    go p = stateful \gs -> Tuple gs.newSeed <$> test p

-- | A version of `quickCheckPure` with the property specialized to `Gen`.
quickCheckGenPure :: forall prop. Testable prop => Seed -> Int -> Gen prop -> List Result
quickCheckGenPure = quickCheckPure

-- | A version of `quickCheckPure'` with the property specialized to `Gen`.
quickCheckGenPure' :: forall prop. Testable prop => Seed -> Int -> Gen prop -> List (Tuple Seed Result)
quickCheckGenPure' = quickCheckPure'

-- | A type used to summarise the results from `quickCheckPure'`
type ResultSummary =
  { total :: Int
  , successes :: Int
  , failures :: List { index :: Int, seed :: Seed, message :: String }
  }

-- | Processes the results from `quickCheckPure'` to produce a `ResultSummary`.
checkResults :: List (Tuple Seed Result) -> ResultSummary
checkResults = foldlWithIndex go { total: 0, successes: 0, failures: List.Nil }
  where
    go :: Int -> ResultSummary -> Tuple Seed Result -> ResultSummary
    go index st (Tuple seed result) =
      case result of
        Success ->
          st { total = st.total + 1, successes = st.successes + 1 }
        Failed message ->
          st { total = st.total + 1, failures = List.Cons { index, seed, message } st.failures }

-- | Print a one-line summary in the form "x/y test(s) passed."
printSummary :: ResultSummary -> String
printSummary summary =
  show summary.successes <> "/" <> show summary.total
    <> if summary.total == 1 then " test passed." else " tests passed."

-- | The `Testable` class represents _testable properties_.
-- |
-- | A testable property is a function of zero or more `Arbitrary` arguments,
-- | returning a `Boolean` or `Result`.
-- |
-- | Testable properties can be passed to the `quickCheck` function.
class Testable prop where
  test :: prop -> Gen Result

instance testableResult :: Testable Result where
  test = pure

instance testableBoolean :: Testable Boolean where
  test true = pure Success
  test false = pure $ Failed "Test returned false"

instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
  test f = arbitrary >>= test <<< f

instance testableGen :: Testable prop => Testable (Gen prop) where
  test = flip bind test

-- | The result of a test: success or failure (with an error message).
data Result = Success | Failed String

instance showResult :: Show Result where
  show Success = "Success"
  show (Failed msg) = "Failed: " <> msg

-- | This operator attaches an error message to a failed test.
-- |
-- | For example:
-- |
-- | ```purescript
-- | test x = myProperty x <?> ("myProperty did not hold for " <> show x)
-- | ```
withHelp :: Boolean -> String -> Result
withHelp true _ = Success
withHelp false msg = Failed msg

infix 2 withHelp as <?>

-- | Self-documenting comparison operation
assertOp :: forall a. Eq a => Show a => (a -> a -> Boolean) -> String -> a -> a -> Result
assertOp op failString a b = a `op` b <?> show a <> failString <> show b

-- | Self-documenting equality assertion
assertEquals :: forall a. Eq a => Show a => a -> a -> Result
assertEquals = assertOp (==) " /= "

infix 2 assertEquals as ===
infix 2 assertEquals as ==?

-- | Self-documenting inequality assertion
assertNotEquals :: forall a. Eq a => Show a => a -> a -> Result
assertNotEquals = assertOp (/=) " == "

infix 2 assertNotEquals as /==
infix 2 assertNotEquals as /=?

assertLessThan :: forall a. Ord a => Show a => a -> a -> Result
assertLessThan = assertOp (<) " >= "

infix 2 assertLessThan as <?

assertLessThanEq :: forall a. Ord a => Show a => a -> a -> Result
assertLessThanEq = assertOp (<=) " > "

infix 2 assertLessThanEq as <=?

assertGreaterThan :: forall a. Ord a => Show a => a -> a -> Result
assertGreaterThan = assertOp (>) " <= "

infix 2 assertGreaterThan as >?

assertGreaterThanEq :: forall a. Ord a => Show a => a -> a -> Result
assertGreaterThanEq = assertOp (>=) " < "

infix 2 assertGreaterThanEq as >=?

-- | This module is a partial port of the Haskell QuickCheck library.
-- |
-- | QuickCheck provides a way to write _property-based_ tests.
-- |
-- | The `Arbitrary` and `CoArbitrary` type classes allow us to create
-- | random data with which we can run our tests. This module provides
-- | instances of both classes for PureScript's core data structures,
-- | as well as functions for writing new instances.
-- |
-- | Test suites can use the `quickCheck` and `quickCheckPure` functions
-- | to test properties.
-- |
-- | For example:
-- |
-- | ```purescript
-- | main = quickCheck \n -> n + 1 > n
-- | ```
module Test.QuickCheck
  ( quickCheck
  , quickCheckGen
  , quickCheck'
  , quickCheckGen'
  , quickCheckWithSeed
  , quickCheckGenWithSeed
  , quickCheckPure
  , quickCheckGenPure
  , class Testable
  , test
  , Result(..)
  , withHelp
  , (<?>)
  , assertEquals
  , (===)
  , (==?)
  , assertNotEquals
  , (/==)
  , (/=?)
  , assertLessThan
  , (<?)
  , assertLessThanEq
  , (<=?)
  , assertGreaterThan
  , (>?)
  , assertGreaterThanEq
  , (>=?)
  , module Random.LCG
  , module Test.QuickCheck.Arbitrary
  ) where

import Prelude

import Control.Monad.Rec.Class (Step(..), tailRec)
import Data.Foldable (for_)
import Data.List (List)
import Data.Maybe (Maybe(..))
import Data.Maybe.First (First(..))
import Data.Tuple (Tuple(..))
import Data.Unfoldable (replicateA)
import Effect (Effect)
import Effect.Console (log)
import Effect.Exception (throwException, error)
import Random.LCG (Seed, mkSeed, unSeed, randomSeed)
import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
import Test.QuickCheck.Gen (Gen, evalGen, runGen)

-- | Test a property.
-- |
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall prop. Testable prop => prop -> Effect Unit
quickCheck prop = quickCheck' 100 prop

-- | A version of `quickCheck` with the property specialized to `Gen`.
-- |
-- | The `quickCheckGen` variants are useful for writing property tests where a
-- | `MonadGen` constraint (or QuickCheck's `Gen` directly) is being used,
-- | rather than relying on `Arbitrary` instances. Especially useful for the
-- | `MonadGen`-constrained properties as they will not infer correctly when
-- | used with the `quickCheck` functions unless an explicit type annotation is
-- | used.
quickCheckGen :: forall prop. Testable prop => Gen prop -> Effect Unit
quickCheckGen = quickCheck

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
quickCheck' :: forall prop. Testable prop => Int -> prop -> Effect Unit
quickCheck' n prop = do
  seed <- randomSeed
  quickCheckWithSeed seed n prop

-- | A version of `quickCheck'` with the property specialized to `Gen`.
quickCheckGen' :: forall prop. Testable prop => Int -> Gen prop -> Effect Unit
quickCheckGen' = quickCheck'

-- | A variant of the `quickCheck'` function that accepts a specific seed as
-- | well as the number tests that should be run.
quickCheckWithSeed
  :: forall prop. Testable prop => Seed -> Int -> prop -> Effect Unit
quickCheckWithSeed initialSeed n prop = do
  let result = tailRec loop { seed: initialSeed, index: 0, successes: 0, firstFailure: mempty }
  log $ show result.successes <> "/" <> show n <> " test(s) passed."
  for_ result.firstFailure \{ index, message, seed: failureSeed } ->
    throwException $ error
      $ "Test " <> show (index + 1)
      <> " (seed " <> show (unSeed failureSeed) <> ") failed: \n"
      <> message
  where
  loop :: LoopState -> Step LoopState LoopState
  loop state@{ seed, index, successes, firstFailure }
    | index == n = Done state
    | otherwise =
        case runGen (test prop) { newSeed: seed, size: 10 } of
          Tuple Success s ->
            Loop
              { seed: s.newSeed
              , index: index + 1
              , successes: successes + 1
              , firstFailure
              }
          Tuple (Failed message) s ->
            Loop
              { seed: s.newSeed
              , index: index + 1
              , successes
              , firstFailure:
                  firstFailure <> First (Just { index, message, seed })
              }

-- | A version of `quickCheckWithSeed` with the property specialized to `Gen`.
quickCheckGenWithSeed :: forall prop. Testable prop => Seed -> Int -> Gen prop -> Effect Unit
quickCheckGenWithSeed = quickCheckWithSeed

type LoopState =
  { successes :: Int
  , firstFailure :: First { index :: Int, message :: String, seed :: Seed }
  , seed :: Seed
  , index :: Int
  }

-- | Test a property, returning all test results as a List.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure :: forall prop. Testable prop => Seed -> Int -> prop -> List Result
quickCheckPure s n prop = evalGen (replicateA n (test prop)) { newSeed: s, size: 10 }

-- | A version of `quickCheckPure` with the property specialized to `Gen`.
quickCheckGenPure :: forall prop. Testable prop => Seed -> Int -> Gen prop -> List Result
quickCheckGenPure = quickCheckPure

-- | The `Testable` class represents _testable properties_.
-- |
-- | A testable property is a function of zero or more `Arbitrary` arguments,
-- | returning a `Boolean` or `Result`.
-- |
-- | Testable properties can be passed to the `quickCheck` function.
class Testable prop where
  test :: prop -> Gen Result

instance testableResult :: Testable Result where
  test = pure

instance testableBoolean :: Testable Boolean where
  test true = pure Success
  test false = pure $ Failed "Test returned false"

instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
  test f = arbitrary >>= test <<< f

instance testableGen :: Testable prop => Testable (Gen prop) where
  test = flip bind test

-- | The result of a test: success or failure (with an error message).
data Result = Success | Failed String

instance showResult :: Show Result where
  show Success = "Success"
  show (Failed msg) = "Failed: " <> msg

-- | This operator attaches an error message to a failed test.
-- |
-- | For example:
-- |
-- | ```purescript
-- | test x = myProperty x <?> ("myProperty did not hold for " <> show x)
-- | ```
withHelp :: Boolean -> String -> Result
withHelp true _ = Success
withHelp false msg = Failed msg

infix 2 withHelp as <?>

-- | Self-documenting comparison operation
assertOp :: forall a. Eq a => Show a => (a -> a -> Boolean) -> String -> a -> a -> Result
assertOp op failString a b = a `op` b <?> show a <> failString <> show b

-- | Self-documenting equality assertion
assertEquals :: forall a. Eq a => Show a => a -> a -> Result
assertEquals = assertOp (==) " /= "

infix 2 assertEquals as ===
infix 2 assertEquals as ==?

-- | Self-documenting inequality assertion
assertNotEquals :: forall a. Eq a => Show a => a -> a -> Result
assertNotEquals = assertOp (/=) " == "

infix 2 assertNotEquals as /==
infix 2 assertNotEquals as /=?

assertLessThan :: forall a. Ord a => Show a => a -> a -> Result
assertLessThan = assertOp (<) " >= "

infix 2 assertLessThan as <?

assertLessThanEq :: forall a. Ord a => Show a => a -> a -> Result
assertLessThanEq = assertOp (<=) " > "

infix 2 assertLessThanEq as <=?

assertGreaterThan :: forall a. Ord a => Show a => a -> a -> Result
assertGreaterThan = assertOp (>) " <= "

infix 2 assertGreaterThan as >?

assertGreaterThanEq :: forall a. Ord a => Show a => a -> a -> Result
assertGreaterThanEq = assertOp (>=) " < "

infix 2 assertGreaterThanEq as >=?


warnings

warnings

module Main where

import Prelude (Unit, bind, (<$), (<*), (<<<), ($))

import Control.Alt ((<|>))
import Control.Monad.Aff (forkAff, Aff)
import Control.Monad.Eff (Eff())

import Data.Maybe (Maybe)
import Data.Tuple (Tuple(..))
import Data.Functor.Coproduct (left)
import Halogen (HalogenEffects, Driver, action, parentState, runUI)
import Halogen.Util (awaitBody, runHalogenAff)

import Routing (matchesAff)
import Routing.Match (Match)
import Routing.Match.Class (lit)

import Model (Page(..), initialPage)
import Component.Page

main :: Eff (HalogenEffects (PageEffects ())) Unit
main = runHalogenAff do
  body <- awaitBody
  driver <- runUI page (parentState initialPage) body
  forkAff $ routeSignal driver

routeSignal :: forall eff. Driver FQuery eff -> Aff (HalogenEffects eff) Unit
routeSignal driver = do
  Tuple old new <- matchesAff routing
  redirects driver old new

redirects :: forall eff. Driver FQuery eff
             -> Maybe Page
             -> Page
             -> Aff (HalogenEffects eff) Unit
redirects d _ = d  <<< left <<< action <<< Navigate

routing :: Match Page
routing = AboutPage <$ lit "" <* lit "about"
          <|> PongPage <$ lit "" <* lit "pong"
          <|> BlogPage <$ lit ""

module Main where

import Prelude

import Control.Apply
import Control.Alt ((<|>))
import Control.Monad.Aff (runAff, forkAff, Aff(..))
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)

import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Functor
import Data.Functor.Coproduct (left)
import Halogen
import Halogen.Util (awaitBody, runHalogenAff)

import Routing
import Routing.Match
import Routing.Match.Class

import Model
import Component.Page

main :: forall e . Eff (HalogenEffects (PageEffects ())) Unit
main = runHalogenAff do
  body <- awaitBody
  driver <- runUI page (parentState initialPage) body
  forkAff $ routeSignal driver

routeSignal :: forall eff. Driver FQuery eff -> Aff (HalogenEffects eff) Unit
routeSignal driver = do
  Tuple old new <- matchesAff routing
  redirects driver old new

redirects :: forall eff. Driver FQuery eff
             -> Maybe Page
             -> Page
             -> Aff (HalogenEffects eff) Unit
redirects d _ = d  <<< left <<< action <<< Navigate

routing :: Match Page
routing = AboutPage <$ lit "" <* lit "about"
          <|> PongPage <$ lit "" <* lit "pong"
          <|> BlogPage <$ lit ""


Foldable1.intercalate and Foldable1.intercalateMap

Relaxes `Foldable.interacalate`'s `Monoid` constraint to `Semigroup`.

module Data.Semigroup.Foldable
  ( class Foldable1
  , foldMap1
  , fold1
  , traverse1_
  , for1_
  , sequence1_
  , foldMap1Default
  , fold1Default
  , intercalate
  , intercalateMap
  ) where

import Prelude

import Data.Foldable (class Foldable)
import Data.Monoid.Dual (Dual(..))
import Data.Monoid.Multiplicative (Multiplicative(..))
import Data.Newtype (ala)
import Data.Ord.Max (Max(..))
import Data.Ord.Min (Min(..))

-- | `Foldable1` represents data structures with a minimum of one element that can be _folded_.
-- |
-- | - `fold1` folds a structure using a `Semigroup` instance
-- | - `foldMap1` folds a structure by accumulating values in a `Semigroup`
-- |
-- | Default implementations are provided by the following functions:
-- |
-- | - `fold1Default`
-- | - `foldMap1Default`
-- |
-- | Note: some combinations of the default implementations are unsafe to
-- | use together - causing a non-terminating mutually recursive cycle.
-- | These combinations are documented per function.
class Foldable t <= Foldable1 t where
  foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m
  fold1 :: forall m. Semigroup m => t m -> m

-- | A default implementation of `fold1` using `foldMap1`.
fold1Default :: forall t m. Foldable1 t => Semigroup m => t m -> m
fold1Default = foldMap1 id

-- | A default implementation of `foldMap1` using `fold1`.
foldMap1Default :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m
foldMap1Default f = (map f) >>> fold1

instance foldableDual :: Foldable1 Dual where
  foldMap1 f (Dual x) = f x
  fold1 = fold1Default

instance foldableMultiplicative :: Foldable1 Multiplicative where
  foldMap1 f (Multiplicative x) = f x
  fold1 = fold1Default

newtype Act f a = Act (f a)

getAct :: forall f a. Act f a -> f a
getAct (Act f) = f

instance semigroupAct :: Apply f => Semigroup (Act f a) where
  append (Act a) (Act b) = Act (a *> b)

-- | Traverse a data structure, performing some effects encoded by an
-- | `Apply` instance at each value, ignoring the final result.
traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit
traverse1_ f t = unit <$ getAct (foldMap1 (Act <<< f) t)

-- | A version of `traverse1_` with its arguments flipped.
-- |
-- | This can be useful when running an action written using do notation
-- | for every element in a data structure:
for1_ :: forall t f a b. Foldable1 t => Apply f => t a -> (a -> f b) -> f Unit
for1_ = flip traverse1_

-- | Perform all of the effects in some data structure in the order
-- | given by the `Foldable1` instance, ignoring the final result.
sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit
sequence1_ = traverse1_ id

maximum :: forall f a. Ord a => Foldable1 f => f a -> a
maximum = ala Max foldMap1

minimum :: forall f a. Ord a => Foldable1 f => f a -> a
minimum = ala Min foldMap1

-- | Internal. Used by intercalation functions.
newtype JoinWith a = JoinWith (a -> a)

joinee :: forall a. JoinWith a -> a -> a
joinee (JoinWith x) = x

instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where
  append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j

-- | Fold a data structure using a `Semigroup` instance,
-- | combining adjacent elements using the specified separator.
intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m
intercalate = flip intercalateMap id

-- | Fold a data structure, accumulating values in some `Semigroup`,
-- | combining adjacent elements using the specified separator.
intercalateMap
  :: forall f m a
   . Foldable1 f
  => Semigroup m
  => m -> (a -> m) -> f a -> m
intercalateMap j f foldable =
  joinee (foldMap1 (JoinWith <<< const <<< f) foldable) j

module Data.Semigroup.Foldable
  ( class Foldable1
  , foldMap1
  , fold1
  , traverse1_
  , for1_
  , sequence1_
  , foldMap1Default
  , fold1Default
  ) where

import Prelude
import Data.Foldable (class Foldable)
import Data.Monoid.Dual (Dual(..))
import Data.Monoid.Multiplicative (Multiplicative(..))
import Data.Newtype (ala)
import Data.Ord.Max (Max(..))
import Data.Ord.Min (Min(..))

-- | `Foldable1` represents data structures with a minimum of one element that can be _folded_.
-- |
-- | - `fold1` folds a structure using a `Semigroup` instance
-- | - `foldMap1` folds a structure by accumulating values in a `Semigroup`
-- |
-- | Default implementations are provided by the following functions:
-- |
-- | - `fold1Default`
-- | - `foldMap1Default`
-- |
-- | Note: some combinations of the default implementations are unsafe to
-- | use together - causing a non-terminating mutually recursive cycle.
-- | These combinations are documented per function.
class Foldable t <= Foldable1 t where
  foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m
  fold1 :: forall m. Semigroup m => t m -> m

-- | A default implementation of `fold1` using `foldMap1`.
fold1Default :: forall t m. Foldable1 t => Semigroup m => t m -> m
fold1Default = foldMap1 id

-- | A default implementation of `foldMap1` using `fold1`.
foldMap1Default :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m
foldMap1Default f = (map f) >>> fold1

instance foldableDual :: Foldable1 Dual where
  foldMap1 f (Dual x) = f x
  fold1 = fold1Default

instance foldableMultiplicative :: Foldable1 Multiplicative where
  foldMap1 f (Multiplicative x) = f x
  fold1 = fold1Default

newtype Act f a = Act (f a)

getAct :: forall f a. Act f a -> f a
getAct (Act f) = f

instance semigroupAct :: Apply f => Semigroup (Act f a) where
  append (Act a) (Act b) = Act (a *> b)

-- | Traverse a data structure, performing some effects encoded by an
-- | `Apply` instance at each value, ignoring the final result.
traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit
traverse1_ f t = unit <$ getAct (foldMap1 (Act <<< f) t)

-- | A version of `traverse1_` with its arguments flipped.
-- |
-- | This can be useful when running an action written using do notation
-- | for every element in a data structure:
for1_ :: forall t f a b. Foldable1 t => Apply f => t a -> (a -> f b) -> f Unit
for1_ = flip traverse1_

-- | Perform all of the effects in some data structure in the order
-- | given by the `Foldable1` instance, ignoring the final result.
sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit
sequence1_ = traverse1_ id

maximum :: forall f a. Ord a => Foldable1 f => f a -> a
maximum = ala Max foldMap1

minimum :: forall f a. Ord a => Foldable1 f => f a -> a
minimum = ala Min foldMap1


forget to add to export list

forget to add to export list

-- | This module enumerates some common HTML attributes, and provides additional
-- | helper functions for working with CSS classes.

module Halogen.HTML.Attributes
  ( ClassName()
  , className
  , runClassName

  , addClass

  , attribute

  , alt
  , charset
  , class_
  , classes
  , content
  , for
  , height
  , href
  , httpEquiv
  , id_
  , name
  , rel
  , src
  , target
  , title
  , type_
  , value
  , width
  , disabled
  , enabled
  , checked
  , placeholder
  , style
  ) where

import DOM

import Data.Tuple
import Data.Either (either)
import Data.Foreign
import Data.StrMap (StrMap())
import Data.Monoid (mempty)
import Data.Array (map)
import Data.String (joinWith)
import Data.Traversable (mapAccumL)

import Control.Monad.Eff
import Control.Monad.ST

import Halogen.Internal.VirtualDOM

import qualified Halogen.HTML as H

-- | A wrapper for strings which are used as CSS classes
newtype ClassName = ClassName String

-- Create a class name
className :: String -> ClassName
className = ClassName

-- | Unpack a class name
runClassName :: ClassName -> String
runClassName (ClassName s) = s

-- \ This convenience function can be used to add a class name to an existing set of attributes.
-- |
-- | If the `class` attribute already exists, the class name will be appended. If not, it will be added as
-- | a new attribute.
addClass :: forall i. ClassName -> H.Attribute i -> H.Attribute i
addClass cn@(ClassName c) (H.Attribute xs) =
  case mapAccumL go false xs of
    Tuple false ys -> H.Attribute ys <> class_ cn
    Tuple true ys -> H.Attribute ys
  where
  go :: Boolean -> Tuple H.AttributeName (H.AttributeValue i) -> Tuple Boolean (Tuple H.AttributeName (H.AttributeValue i))
  go false (Tuple name (H.ValueAttribute cs)) | H.runAttributeName name == className =
    Tuple true (Tuple (H.attributeName className) (H.ValueAttribute (cs ++ " " ++ c)))
  go b (Tuple k v) = Tuple b (Tuple k v)

  className :: String
  className = "className"

-- | This function can be used to define custom attributes.
attribute :: forall i value. H.AttributeName -> String -> H.Attribute i
attribute key value = H.Attribute [Tuple key (H.ValueAttribute value)]

alt :: forall i. String -> H.Attribute i
alt = attribute $ H.attributeName "alt"

charset :: forall i. String -> H.Attribute i
charset = attribute $ H.attributeName "charset"

class_ :: forall i. ClassName -> H.Attribute i
class_ = attribute (H.attributeName "className") <<< runClassName

classes :: forall i. [ClassName] -> H.Attribute i
classes ss = attribute (H.attributeName "className") (joinWith " " $ map runClassName ss)

content :: forall i. String -> H.Attribute i
content = attribute $ H.attributeName "content"

for :: forall i. String -> H.Attribute i
for = attribute $ H.attributeName "for"

height :: forall i. Number -> H.Attribute i
height = attribute (H.attributeName "height") <<< show

href :: forall i. String -> H.Attribute i
href = attribute $ H.attributeName "href"

httpEquiv :: forall i. String -> H.Attribute i
httpEquiv = attribute $ H.attributeName "http-equiv"

id_ :: forall i. String -> H.Attribute i
id_ = attribute $ H.attributeName "id"

name :: forall i. String -> H.Attribute i
name = attribute $ H.attributeName "name"

rel :: forall i. String -> H.Attribute i
rel = attribute $ H.attributeName "rel"

src :: forall i. String -> H.Attribute i
src = attribute $ H.attributeName "src"

target :: forall i. String -> H.Attribute i
target = attribute $ H.attributeName "target"

title :: forall i. String -> H.Attribute i
title = attribute $ H.attributeName "title"

type_ :: forall i. String -> H.Attribute i
type_ = attribute $ H.attributeName "type"

value :: forall i. String -> H.Attribute i
value = attribute $ H.attributeName "value"

width :: forall i. Number -> H.Attribute i
width = attribute (H.attributeName "width") <<< show

disabled :: forall i. Boolean -> H.Attribute i
disabled false = mempty
disabled true = attribute (H.attributeName "disabled") "disabled"

enabled :: forall i. Boolean -> H.Attribute i
enabled = disabled <<< not

checked :: forall i. Boolean -> H.Attribute i
checked false = mempty
checked true = attribute (H.attributeName "checked") "checked"

placeholder :: forall i. String -> H.Attribute i
placeholder = attribute $ H.attributeName "placeholder"

style :: forall i. StrMap String -> H.Attribute i
style m = H.Attribute [Tuple (H.attributeName "style") (H.MapAttribute m)]

-- | This module enumerates some common HTML attributes, and provides additional
-- | helper functions for working with CSS classes.

module Halogen.HTML.Attributes
  ( ClassName()
  , className
  , runClassName

  , addClass

  , attribute

  , alt
  , charset
  , class_
  , classes
  , content
  , for
  , height
  , href
  , httpEquiv
  , id_
  , name
  , rel
  , src
  , target
  , title
  , type_
  , value
  , width
  , disabled
  , enabled
  , checked
  , placeholder
  ) where

import DOM

import Data.Tuple
import Data.Either (either)
import Data.Foreign
import Data.StrMap (StrMap())
import Data.Monoid (mempty)
import Data.Array (map)
import Data.String (joinWith)
import Data.Traversable (mapAccumL)

import Control.Monad.Eff
import Control.Monad.ST

import Halogen.Internal.VirtualDOM

import qualified Halogen.HTML as H

-- | A wrapper for strings which are used as CSS classes
newtype ClassName = ClassName String

-- Create a class name
className :: String -> ClassName
className = ClassName

-- | Unpack a class name
runClassName :: ClassName -> String
runClassName (ClassName s) = s

-- \ This convenience function can be used to add a class name to an existing set of attributes.
-- |
-- | If the `class` attribute already exists, the class name will be appended. If not, it will be added as
-- | a new attribute.
addClass :: forall i. ClassName -> H.Attribute i -> H.Attribute i
addClass cn@(ClassName c) (H.Attribute xs) =
  case mapAccumL go false xs of
    Tuple false ys -> H.Attribute ys <> class_ cn
    Tuple true ys -> H.Attribute ys
  where
  go :: Boolean -> Tuple H.AttributeName (H.AttributeValue i) -> Tuple Boolean (Tuple H.AttributeName (H.AttributeValue i))
  go false (Tuple name (H.ValueAttribute cs)) | H.runAttributeName name == className =
    Tuple true (Tuple (H.attributeName className) (H.ValueAttribute (cs ++ " " ++ c)))
  go b (Tuple k v) = Tuple b (Tuple k v)

  className :: String
  className = "className"

-- | This function can be used to define custom attributes.
attribute :: forall i value. H.AttributeName -> String -> H.Attribute i
attribute key value = H.Attribute [Tuple key (H.ValueAttribute value)]

alt :: forall i. String -> H.Attribute i
alt = attribute $ H.attributeName "alt"

charset :: forall i. String -> H.Attribute i
charset = attribute $ H.attributeName "charset"

class_ :: forall i. ClassName -> H.Attribute i
class_ = attribute (H.attributeName "className") <<< runClassName

classes :: forall i. [ClassName] -> H.Attribute i
classes ss = attribute (H.attributeName "className") (joinWith " " $ map runClassName ss)

content :: forall i. String -> H.Attribute i
content = attribute $ H.attributeName "content"

for :: forall i. String -> H.Attribute i
for = attribute $ H.attributeName "for"

height :: forall i. Number -> H.Attribute i
height = attribute (H.attributeName "height") <<< show

href :: forall i. String -> H.Attribute i
href = attribute $ H.attributeName "href"

httpEquiv :: forall i. String -> H.Attribute i
httpEquiv = attribute $ H.attributeName "http-equiv"

id_ :: forall i. String -> H.Attribute i
id_ = attribute $ H.attributeName "id"

name :: forall i. String -> H.Attribute i
name = attribute $ H.attributeName "name"

rel :: forall i. String -> H.Attribute i
rel = attribute $ H.attributeName "rel"

src :: forall i. String -> H.Attribute i
src = attribute $ H.attributeName "src"

target :: forall i. String -> H.Attribute i
target = attribute $ H.attributeName "target"

title :: forall i. String -> H.Attribute i
title = attribute $ H.attributeName "title"

type_ :: forall i. String -> H.Attribute i
type_ = attribute $ H.attributeName "type"

value :: forall i. String -> H.Attribute i
value = attribute $ H.attributeName "value"

width :: forall i. Number -> H.Attribute i
width = attribute (H.attributeName "width") <<< show

disabled :: forall i. Boolean -> H.Attribute i
disabled false = mempty
disabled true = attribute (H.attributeName "disabled") "disabled"

enabled :: forall i. Boolean -> H.Attribute i
enabled = disabled <<< not

checked :: forall i. Boolean -> H.Attribute i
checked false = mempty
checked true = attribute (H.attributeName "checked") "checked"

placeholder :: forall i. String -> H.Attribute i
placeholder = attribute $ H.attributeName "placeholder"

style :: forall i. StrMap String -> H.Attribute i
style m = H.Attribute [Tuple (H.attributeName "style") (H.MapAttribute m)]


Comments for optionals in Go

Comments for optionals in Go

Original commit 75d9c10cf74068aa32d9409367af356b55265193

module Golang
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isDigit, isLetter)
import Data.Foldable (for_, intercalate)
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, stringEscape)
import Data.Tuple (Tuple(..))
import Utils (mapM, removeElement)

renderer :: Renderer
renderer =
    { name: "Go"
    , aceMode: "golang"
    , extension: "go"
    , doc: golangDoc
    , transforms:
        { nameForClass
        , unionName
        , unionPredicate
        , nextName: \s -> "Other" <> s
        , forbiddenNames: []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = goNameStyle $ combineNames names

unionName :: L.List String -> String
unionName s =
    L.sort s
    <#> goNameStyle
    # intercalate "Or"

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType IRString = true
isValueType (IRClass _) = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || c == '_'

isStartCharacter :: Char -> Boolean
isStartCharacter = isLetterCharacter

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    isLetterCharacter c || isDigit c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

renderUnionToGolang :: Set IRType -> Doc (Tuple String (Maybe String))
renderUnionToGolang s =
    case nullableFromSet s of
    Just x -> do
        Tuple rendered comment <- renderTypeToGolang x
        pure if isValueType x then Tuple ("*" <> rendered) (Just $ maybe "optional" ("optional "<> _) comment) else Tuple rendered Nothing
    Nothing -> do
        name <- lookupUnionName s
        pure $ Tuple name Nothing

renderTypeToGolang :: IRType -> Doc (Tuple String (Maybe String))
renderTypeToGolang = case _ of
    IRNothing -> pure $ Tuple "interface{}" Nothing
    IRNull -> pure $ Tuple "interface{}" Nothing
    IRInteger -> pure $ Tuple "int64" Nothing
    IRDouble -> pure $ Tuple "float64" Nothing
    IRBool -> pure $ Tuple "bool" Nothing
    IRString -> pure $ Tuple "string" Nothing
    IRArray a -> do
        (Tuple rendered comment) <- renderTypeToGolang a
        pure $ Tuple ("[]" <> rendered) (map ("array of " <> _) comment)
    IRClass i -> do
        name <- lookupClassName i
        pure $ Tuple name Nothing
    IRMap t -> do
        (Tuple rendered comment) <- renderTypeToGolang t
        pure $ Tuple ("map[string]" <> rendered) (map ("map to " <> _) comment)
    IRUnion types -> renderUnionToGolang $ unionToSet types

renderComment :: Maybe String -> String
renderComment (Just s) = " // " <> s
renderComment Nothing = ""

goNameStyle :: String -> String
goNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

golangDoc :: Doc Unit
golangDoc = do
    line """// To parse and unparse this JSON data, add this code to your project and do:
//
//    r, err := UnmarshalRoot(bytes)
//    bytes, err = r.Marshal()

package main
"""
    unions <- getUnions
    unless (unions == L.Nil) do
        line "import \"bytes\""
        line "import \"errors\""
    line "import \"encoding/json\""
    blank
    (Tuple renderedToplevel toplevelComment) <- getTopLevel >>= renderTypeToGolang
    line $ "type Root " <> renderedToplevel <> (renderComment toplevelComment)
    blank
    line """func UnmarshalRoot(data []byte) (Root, error) {
	var r Root
	err := json.Unmarshal(data, &r)
	return r, err
}

func (r *Root) Marshal() ([]byte, error) {
	return json.Marshal(r)
}
"""
    classes <- getClasses
    for_ classes \(Tuple i cls) -> do
        renderGolangType i cls
        blank
    unless (unions == L.Nil) do
        line """func unmarshalUnion(data []byte, pi **int64, pf **float64, pb **bool, ps **string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) (bool, error) {
	if pi != nil {
		*pi = nil
	}
	if pf != nil {
		*pf = nil
	}
	if pb != nil {
		*pb = nil
	}
	if ps != nil {
		*ps = nil
	}

	dec := json.NewDecoder(bytes.NewReader(data))
	dec.UseNumber()
	tok, err := dec.Token()
	if err != nil {
		return false, err
	}

	switch v := tok.(type) {
	case json.Number:
		if pi != nil {
			i, err := v.Int64()
			if err == nil {
				*pi = &i
				return false, nil
			}
		}
		if pf != nil {
			f, err := v.Float64()
			if err == nil {
				*pf = &f
				return false, nil
			}
			return false, errors.New("Unparsable number")
		}
		return false, errors.New("Union does not contain number")
	case float64:
		return false, errors.New("Decoder should not return float64")
	case bool:
		if pb != nil {
			*pb = &v
			return false, nil
		}
		return false, errors.New("Union does not contain bool")
	case string:
		if ps != nil {
			*ps = &v
			return false, nil
		}
		return false, errors.New("Union does not contain string")
	case nil:
		if nullable {
			return false, nil
		}
		return false, errors.New("Union does not contain null")
	case json.Delim:
		if v == '{' {
			if haveObject {
				return true, json.Unmarshal(data, pc)
			}
			if haveMap {
				return false, json.Unmarshal(data, pm)
			}
			return false, errors.New("Union does not contain object")
		}
		if v == '[' {
			if haveArray {
				return false, json.Unmarshal(data, pa)
			}
			return false, errors.New("Union does not contain array")
		}
		return false, errors.New("Cannot handle delimiter")
	}
	return false, errors.New("Cannot unmarshal union")

}

func marshalUnion(pi *int64, pf *float64, pb *bool, ps *string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) ([]byte, error) {
	if pi != nil {
		return json.Marshal(*pi)
	}
	if pf != nil {
		return json.Marshal(*pf)
	}
	if pb != nil {
		return json.Marshal(*pb)
	}
	if ps != nil {
		return json.Marshal(*ps)
	}
	if haveArray {
		return json.Marshal(pa)
	}
	if haveObject {
		return json.Marshal(pc)
	}
	if haveMap {
		return json.Marshal(pm)
	}
	if nullable {
		return json.Marshal(nil)
	}
	return nil, errors.New("Union must not be null")
}
"""
    for_ unions \types -> do
        renderGolangUnion types
        blank

renderGolangType :: Int -> IRClassData -> Doc Unit
renderGolangType classIndex (IRClassData { names, properties }) = do
    className <- lookupClassName classIndex
    let propertyNames = transformNames goNameStyle ("Other" <> _) S.empty $ map (\n -> Tuple n n) $ Map.keys properties
    line $ "type " <> className <> " struct {"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            let csPropName = lookupName pname propertyNames
            Tuple rendered comment <- renderTypeToGolang ptype
            line $ csPropName <> " " <> rendered <> " `json:\"" <> (stringEscape pname) <> "\"`" <> (renderComment comment)
    line "}"

unionFieldName :: IRType -> Doc String
unionFieldName t = goNameStyle <$> getTypeNameForUnion t

compoundPredicates :: Array (IRType -> Boolean)
compoundPredicates = [isArray, isClass, isMap]

renderGolangUnion :: Set IRType -> Doc Unit
renderGolangUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    let isNullableString = if isJust emptyOrNull then "true" else "false"
    line $ "type " <> name <> " struct {"
    indent do
        for_ nonNullTypes \t -> do
            Tuple typeString comment <- renderUnionToGolang $ S.union (S.singleton t) (S.singleton IRNull)
            field <- unionFieldName t
            line $ field <> " " <> typeString <> (renderComment comment)
    line "}"
    blank
    line $ "func (x *" <> name <> ") UnmarshalJSON(data []byte) error {"
    indent do
        for_ compoundPredicates \p -> maybeAssignNil p
        ifClass \name -> do
            line $ "var c " <> name
        args <- makeArgs primitiveUnmarshalArg compoundUnmarshalArg
        line $ "object, err := unmarshalUnion(data, " <> args <> ", " <> isNullableString <> ")"
        line "if err != nil {"
        indent do
    		line "return err"
        line "}"
        line "if object {"
        ifClass \name -> do
            indent do
                line $ "x." <> name <> " = &c"
        line "}"
        line "return nil"
    line "}"
    blank
    line $ "func (x *" <> name <> ") MarshalJSON() ([]byte, error) {"
    indent do
        args <- makeArgs primitiveMarshalArg compoundMarshalArg
        line $ "return marshalUnion(" <> args <> ", " <> isNullableString <> ")"
    line "}"
    where
        ifClass :: (String -> Doc Unit) -> Doc Unit
        ifClass f =
            let { element } = removeElement isClass allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    f name
                Nothing -> pure unit
        maybeAssignNil p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    line $ "x." <> name <> " = nil"
                Nothing -> pure unit
        makeArgs :: (IRType -> Doc String) -> ((IRType -> Boolean) -> Doc String) -> Doc String
        makeArgs primitive compound = do
            primitiveArgs <- mapM primitive $ L.fromFoldable [IRInteger, IRDouble, IRBool, IRString]
            compoundArgs <- mapM compound $ L.fromFoldable compoundPredicates
            pure $ intercalate ", " $ A.concat [A.fromFoldable primitiveArgs, A.fromFoldable compoundArgs]
        memberArg :: String -> (IRType -> String -> String) -> (IRType -> Boolean) -> Doc String
        memberArg notPresentValue renderPresent p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    pure $ renderPresent t name
                Nothing -> pure notPresentValue
        primitiveUnmarshalArg t =
            memberArg "nil" (\_ n -> "&x." <> n) (eq t)
        compoundUnmarshalArg p =
            memberArg "false, nil" (\t n -> if isClass t then "true, &c" else "true, &x." <> n) p
        primitiveMarshalArg :: IRType -> Doc String
        primitiveMarshalArg t =
            memberArg "nil" (\_ n -> "x." <> n) (eq t)
        compoundMarshalArg :: (IRType -> Boolean) -> Doc String
        compoundMarshalArg p =
            memberArg "false, nil" (\t n -> "x." <> n <> " != nil, x." <> n) p

module Golang
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Array as A
import Data.Char.Unicode (isDigit, isLetter)
import Data.Foldable (for_, intercalate)
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.String as Str
import Data.String.Util (capitalize, camelCase, stringEscape)
import Data.Tuple (Tuple(..))
import Utils (mapM, removeElement)

renderer :: Renderer
renderer =
    { name: "Go"
    , aceMode: "golang"
    , extension: "go"
    , doc: golangDoc
    , transforms:
        { nameForClass
        , unionName
        , unionPredicate
        , nextName: \s -> "Other" <> s
        , forbiddenNames: []
        }
    }

unionPredicate :: IRType -> Maybe (Set IRType)
unionPredicate = case _ of
    IRUnion ur ->
        let s = unionToSet ur
        in case nullableFromSet s of
            Nothing -> Just s
            _ -> Nothing
    _ -> Nothing

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = goNameStyle $ combineNames names

unionName :: L.List String -> String
unionName s =
    L.sort s
    <#> goNameStyle
    # intercalate "Or"

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType IRString = true
isValueType (IRClass _) = true
isValueType _ = false

isLetterCharacter :: Char -> Boolean
isLetterCharacter c =
    isLetter c || c == '_'

isStartCharacter :: Char -> Boolean
isStartCharacter = isLetterCharacter

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    isLetterCharacter c || isDigit c

legalizeIdentifier :: String -> String
legalizeIdentifier str =
    case Str.charAt 0 str of
    -- FIXME: use the type to infer a name?
    Nothing -> "Empty"
    Just s ->
        if isStartCharacter s then
            Str.fromCharArray $ map (\c -> if isLetterCharacter c then c else '_') $ Str.toCharArray str
        else
            legalizeIdentifier ("_" <> str)

renderUnionToGolang :: Set IRType -> Doc String
renderUnionToGolang s =
    case nullableFromSet s of
    Just x -> do
        rendered <- renderTypeToGolang x
        pure if isValueType x then "*" <> rendered else rendered
    Nothing -> lookupUnionName s

renderTypeToGolang :: IRType -> Doc String
renderTypeToGolang = case _ of
    IRNothing -> pure "interface{}"
    IRNull -> pure "interface{}"
    IRInteger -> pure "int64"
    IRDouble -> pure "float64"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderTypeToGolang a
        pure $ "[]" <> rendered
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderTypeToGolang t
        pure $ "map[string]" <> rendered
    IRUnion types -> renderUnionToGolang $ unionToSet types

goNameStyle :: String -> String
goNameStyle = camelCase >>> capitalize >>> legalizeIdentifier

golangDoc :: Doc Unit
golangDoc = do
    line """// To parse and unparse this JSON data, add this code to your project and do:
//
//    r, err := UnmarshalRoot(bytes)
//    bytes, err = r.Marshal()

package main
"""
    unions <- getUnions
    unless (unions == L.Nil) do
        line "import \"bytes\""
        line "import \"errors\""
    line "import \"encoding/json\""
    blank
    renderedToplevel <- getTopLevel >>= renderTypeToGolang
    line $ "type Root " <> renderedToplevel
    blank
    line """func UnmarshalRoot(data []byte) (Root, error) {
	var r Root
	err := json.Unmarshal(data, &r)
	return r, err
}

func (r *Root) Marshal() ([]byte, error) {
	return json.Marshal(r)
}
"""
    classes <- getClasses
    for_ classes \(Tuple i cls) -> do
        renderGolangType i cls
        blank
    unless (unions == L.Nil) do
        line """func unmarshalUnion(data []byte, pi **int64, pf **float64, pb **bool, ps **string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) (bool, error) {
	if pi != nil {
		*pi = nil
	}
	if pf != nil {
		*pf = nil
	}
	if pb != nil {
		*pb = nil
	}
	if ps != nil {
		*ps = nil
	}

	dec := json.NewDecoder(bytes.NewReader(data))
	dec.UseNumber()
	tok, err := dec.Token()
	if err != nil {
		return false, err
	}

	switch v := tok.(type) {
	case json.Number:
		if pi != nil {
			i, err := v.Int64()
			if err == nil {
				*pi = &i
				return false, nil
			}
		}
		if pf != nil {
			f, err := v.Float64()
			if err == nil {
				*pf = &f
				return false, nil
			}
			return false, errors.New("Unparsable number")
		}
		return false, errors.New("Union does not contain number")
	case float64:
		return false, errors.New("Decoder should not return float64")
	case bool:
		if pb != nil {
			*pb = &v
			return false, nil
		}
		return false, errors.New("Union does not contain bool")
	case string:
		if ps != nil {
			*ps = &v
			return false, nil
		}
		return false, errors.New("Union does not contain string")
	case nil:
		if nullable {
			return false, nil
		}
		return false, errors.New("Union does not contain null")
	case json.Delim:
		if v == '{' {
			if haveObject {
				return true, json.Unmarshal(data, pc)
			}
			if haveMap {
				return false, json.Unmarshal(data, pm)
			}
			return false, errors.New("Union does not contain object")
		}
		if v == '[' {
			if haveArray {
				return false, json.Unmarshal(data, pa)
			}
			return false, errors.New("Union does not contain array")
		}
		return false, errors.New("Cannot handle delimiter")
	}
	return false, errors.New("Cannot unmarshal union")

}

func marshalUnion(pi *int64, pf *float64, pb *bool, ps *string, haveArray bool, pa interface{}, haveObject bool, pc interface{}, haveMap bool, pm interface{}, nullable bool) ([]byte, error) {
	if pi != nil {
		return json.Marshal(*pi)
	}
	if pf != nil {
		return json.Marshal(*pf)
	}
	if pb != nil {
		return json.Marshal(*pb)
	}
	if ps != nil {
		return json.Marshal(*ps)
	}
	if haveArray {
		return json.Marshal(pa)
	}
	if haveObject {
		return json.Marshal(pc)
	}
	if haveMap {
		return json.Marshal(pm)
	}
	if nullable {
		return json.Marshal(nil)
	}
	return nil, errors.New("Union must not be null")
}
"""
    for_ unions \types -> do
        renderGolangUnion types
        blank

renderGolangType :: Int -> IRClassData -> Doc Unit
renderGolangType classIndex (IRClassData { names, properties }) = do
    className <- lookupClassName classIndex
    let propertyNames = transformNames goNameStyle ("Other" <> _) S.empty $ map (\n -> Tuple n n) $ Map.keys properties
    line $ "type " <> className <> " struct {"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            let csPropName = lookupName pname propertyNames
            rendered <- renderTypeToGolang ptype
            line $ csPropName <> " " <> rendered <> " `json:\"" <> (stringEscape pname) <> "\"`"
    line "}"

unionFieldName :: IRType -> Doc String
unionFieldName t = goNameStyle <$> getTypeNameForUnion t

compoundPredicates :: Array (IRType -> Boolean)
compoundPredicates = [isArray, isClass, isMap]

renderGolangUnion :: Set IRType -> Doc Unit
renderGolangUnion allTypes = do
    name <- lookupUnionName allTypes
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    let isNullableString = if isJust emptyOrNull then "true" else "false"
    line $ "type " <> name <> " struct {"
    indent do
        for_ nonNullTypes \t -> do
            typeString <- renderUnionToGolang $ S.union (S.singleton t) (S.singleton IRNull)
            field <- unionFieldName t
            line $ field <> " " <> typeString
    line "}"
    blank
    line $ "func (x *" <> name <> ") UnmarshalJSON(data []byte) error {"
    indent do
        for_ compoundPredicates \p -> maybeAssignNil p
        ifClass \name -> do
            line $ "var c " <> name
        args <- makeArgs primitiveUnmarshalArg compoundUnmarshalArg
        line $ "object, err := unmarshalUnion(data, " <> args <> ", " <> isNullableString <> ")"
        line "if err != nil {"
        indent do
    		line "return err"
        line "}"
        line "if object {"
        ifClass \name -> do
            indent do
                line $ "x." <> name <> " = &c"
        line "}"
        line "return nil"
    line "}"
    blank
    line $ "func (x *" <> name <> ") MarshalJSON() ([]byte, error) {"
    indent do
        args <- makeArgs primitiveMarshalArg compoundMarshalArg
        line $ "return marshalUnion(" <> args <> ", " <> isNullableString <> ")"
    line "}"
    where
        ifClass :: (String -> Doc Unit) -> Doc Unit
        ifClass f =
            let { element } = removeElement isClass allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    f name
                Nothing -> pure unit
        maybeAssignNil p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    line $ "x." <> name <> " = nil"
                Nothing -> pure unit
        makeArgs :: (IRType -> Doc String) -> ((IRType -> Boolean) -> Doc String) -> Doc String
        makeArgs primitive compound = do
            primitiveArgs <- mapM primitive $ L.fromFoldable [IRInteger, IRDouble, IRBool, IRString]
            compoundArgs <- mapM compound $ L.fromFoldable compoundPredicates
            pure $ intercalate ", " $ A.concat [A.fromFoldable primitiveArgs, A.fromFoldable compoundArgs]
        memberArg :: String -> (IRType -> String -> String) -> (IRType -> Boolean) -> Doc String
        memberArg notPresentValue renderPresent p =
            let { element } = removeElement p allTypes
            in
                case element of
                Just t -> do
                    name <- unionFieldName t
                    pure $ renderPresent t name
                Nothing -> pure notPresentValue
        primitiveUnmarshalArg t =
            memberArg "nil" (\_ n -> "&x." <> n) (eq t)
        compoundUnmarshalArg p =
            memberArg "false, nil" (\t n -> if isClass t then "true, &c" else "true, &x." <> n) p
        primitiveMarshalArg :: IRType -> Doc String
        primitiveMarshalArg t =
            memberArg "nil" (\_ n -> "x." <> n) (eq t)
        compoundMarshalArg :: (IRType -> Boolean) -> Doc String
        compoundMarshalArg p =
            memberArg "false, nil" (\t n -> "x." <> n <> " != nil, x." <> n) p