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 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


Don't hardcode port numbers for examples in integration tests (#46)

module HTTPure.IntegrationSpec where

import Prelude

import Control.Monad.Eff.Class as EffClass
import Data.StrMap as StrMap
import Test.Spec as Spec

import HTTPure.SpecHelpers as SpecHelpers
import HTTPure.SpecHelpers ((?=))

import Headers as Headers
import HelloWorld as HelloWorld
import MultiRoute as MultiRoute
import Post as Post

headersSpec :: SpecHelpers.Test
headersSpec = Spec.it "runs the headers example" do
  EffClass.liftEff Headers.main
  header <- SpecHelpers.getHeader port StrMap.empty "/" "X-Example"
  header ?= "hello world!"
  response <- SpecHelpers.get port (StrMap.singleton "X-Input" "test") "/"
  response ?= "test"
  where port = Headers.port

helloWorldSpec :: SpecHelpers.Test
helloWorldSpec = Spec.it "runs the hello world example" do
  EffClass.liftEff HelloWorld.main
  response <- SpecHelpers.get port StrMap.empty "/"
  response ?= "hello world!"
  where port = HelloWorld.port

multiRouteSpec :: SpecHelpers.Test
multiRouteSpec = Spec.it "runs the multi route example" do
  EffClass.liftEff MultiRoute.main
  hello <- SpecHelpers.get port StrMap.empty "/hello"
  hello ?= "hello"
  goodbye <- SpecHelpers.get port StrMap.empty "/goodbye"
  goodbye ?= "goodbye"
  where port = MultiRoute.port

postSpec :: SpecHelpers.Test
postSpec = Spec.it "runs the post example" do
  EffClass.liftEff Post.main
  response <- SpecHelpers.post port StrMap.empty "/" "test"
  response ?= "test"
  where port = Post.port

integrationSpec :: SpecHelpers.Test
integrationSpec = Spec.describe "Integration" do
  headersSpec
  helloWorldSpec
  multiRouteSpec
  postSpec

module HTTPure.IntegrationSpec where

import Prelude

import Control.Monad.Eff.Class as EffClass
import Data.StrMap as StrMap
import Test.Spec as Spec

import HTTPure.SpecHelpers as SpecHelpers
import HTTPure.SpecHelpers ((?=))

import Headers as Headers
import HelloWorld as HelloWorld
import MultiRoute as MultiRoute
import Post as Post

headersSpec :: SpecHelpers.Test
headersSpec = Spec.it "runs the headers example" do
  EffClass.liftEff Headers.main
  header <- SpecHelpers.getHeader 8082 StrMap.empty "/" "X-Example"
  header ?= "hello world!"
  response <- SpecHelpers.get 8082 (StrMap.singleton "X-Input" "test") "/"
  response ?= "test"

helloWorldSpec :: SpecHelpers.Test
helloWorldSpec = Spec.it "runs the hello world example" do
  EffClass.liftEff HelloWorld.main
  response <- SpecHelpers.get 8080 StrMap.empty "/"
  response ?= "hello world!"

multiRouteSpec :: SpecHelpers.Test
multiRouteSpec = Spec.it "runs the multi route example" do
  EffClass.liftEff MultiRoute.main
  hello <- SpecHelpers.get 8081 StrMap.empty "/hello"
  hello ?= "hello"
  goodbye <- SpecHelpers.get 8081 StrMap.empty "/goodbye"
  goodbye ?= "goodbye"

postSpec :: SpecHelpers.Test
postSpec = Spec.it "runs the post example" do
  EffClass.liftEff Post.main
  response <- SpecHelpers.post 8084 StrMap.empty "/" "test"
  response ?= "test"

integrationSpec :: SpecHelpers.Test
integrationSpec = Spec.describe "Integration" do
  headersSpec
  helloWorldSpec
  multiRouteSpec
  postSpec


Fill only branch that was matched on

Fill only branch that was matched on

...this may need to be re-considered

module Language.Docopt.Trans (
  reduce
  ) where

import Prelude
import Debug.Trace
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.Foldable (foldl)
import Control.Plus (empty)
import Data.Bifunctor (lmap)
import Data.Array as A
import Data.StrMap as StrMap
import Data.StrMap (StrMap())
import Data.Map (Map())
import Data.String (fromChar)
import Data.Monoid (mempty)
import Data.Map as Map
import Data.String as Str
import Data.Tuple (Tuple(..), fst, snd)
import Control.MonadPlus (guard)
import Control.Alt ((<|>))
import Data.Function (on)
import Language.Docopt.Env (Env())
import Language.Docopt.Usage    as D
import Language.Docopt.Errors   as D
import Language.Docopt.Env      as D
import Language.Docopt.Value    as D
import Language.Docopt.Argument as D
import Language.Docopt.Option   as O
import Language.Docopt.Env      as Env
import Data.String.Ext ((^=))
import Data.List (List(..), toList, concat, singleton, groupBy, catMaybes)
import Data.List as L
import Language.Docopt.ParserGen.ValueMapping

newtype Key = Key { arg :: D.Argument }

instance showKey :: Show Key where
  show (Key { arg: (D.Option (O.Option o)) }) =
    maybe "" (\c -> fromChar c ++ ", ") o.flag
      ++ maybe "" id o.name
  show (Key { arg: (D.Positional n _) }) = n
  show (Key { arg: (D.Command n) }) = n
  show _ = "invalid" -- XXX

instance ordKey :: Ord Key where
  compare = compare `on` show -- XXX

instance eqKey :: Eq Key where
  eq (Key { arg: arg0 }) (Key { arg: arg1 }) = go arg0 arg1
    where
      go (D.Positional n _) (D.Positional n' _)
         = n ^= n'
      go (D.Option (O.Option { flag=f,  name=n  }))
         (D.Option (O.Option { flag=f', name=n' }))
         = (f == f') && (n == n')
      go (D.Command n) (D.Command n')
         = n == n'
      go a b = a == b

key :: D.Argument -> Key
key arg = Key { arg: arg }

-- | Reduce the list of (Argument, Value) mappings down to a Set of (String,
-- | Value), where `String` is the name of the argument.
-- |
-- | This reduction is "lossy" as it loses some of the rich information
-- | about the options that have been acquired. It also loses the information
-- | about the origin of the matched value as it could have been user-provded or
-- | derived from the option descriptions (default value, etc.).
-- |
-- | Despite the pitfalls, the reasons for adopting this are:
-- |
-- |   a) Compatibility with original docopt
-- |   b) Easy of use in JS-land. This step could implemented differently for
-- |      consumption in purescript (or any other language for that matter).
-- |
-- | A note on equality:
-- |    Options are considered equal if their names (or both of their aliases)
-- |    match. Modifiers such as repetitiveness or the arguments an option takes
-- |    are *NOT* considered for evaluating option equality.
-- |
reduce :: List D.Usage       -- ^ the program specification
       -> D.Env              -- ^ the environment
       -> D.Branch           -- ^ the matched specification
       -> List ValueMapping  -- ^ the parse result
       -> Map String D.Value -- ^ the output set of (arg => val)
reduce us env b vs =
  let vm = Map.fromFoldableWith resolveArg $ lmap key <$> (prepare <$> vs)
    -- XXX: The following creation of a list of usages is looking funny because
    --      originally this implementation would collect values across all
    --      usage patterns (`us`). However, the new implementation only
    --      considers the branch the user actually matched. Potentially, both
    --      approaches could be combined? The problem with going cross-usage is
    --      that arguments present in multiple usage patterns would falsy be
    --      identified as repeating.
      m  = reduceUsages (singleton $ D.Usage (singleton b)) # applyValues vm
    in expandMap m
  where

    prepare :: ValueMapping -> ValueMapping
    prepare (Tuple a v) | D.isRepeatable a = Tuple a (D.ArrayValue $ valIntoArray v)
    prepare k = k

    expandMap :: Map Key D.Value -> Map String D.Value
    expandMap m = Map.fromFoldable $ concat
                    $ Map.toList m
                        <#> \(Tuple (Key { arg: a }) v) ->
                                flip Tuple v <$> (toList $ toKeys a)

    applyValues :: Map Key D.Value -> List D.Argument -> Map Key D.Value
    applyValues vm as = Map.fromFoldableWith resolveArg
      $ catMaybes
      $ as <#> \a -> Tuple (key a) <$> (getValue vm a <|> getFallback a)

    resolveArg :: D.Value -> D.Value -> D.Value
    resolveArg v v' = D.ArrayValue $ valIntoArray v' ++ valIntoArray v

    valIntoArray (D.ArrayValue xs)  = xs
    valIntoArray v                  = [v]

    reduceUsages :: List D.Usage -> List D.Argument
    reduceUsages us =
      let ms = reduceBranches <<< D.runUsage <$> us
       in Map.values $ foldl (Map.unionWith resolveLCD)
                             Map.empty
                             ms
      where
        reduceBranches :: List D.Branch -> Map Key D.Argument
        reduceBranches bs =
          let ms = combine <<< (expand <$>) <<< D.runBranch <$> bs
          in foldl (Map.unionWith resolveOR)
                    Map.empty
                    ms
          where
            combine :: List (Map Key D.Argument) -> Map Key D.Argument
            combine xs = foldl (Map.unionWith resolveLCD)
                              Map.empty
                              xs

        expand :: D.Argument -> Map Key D.Argument
        expand (D.Group _ bs r) =
          reduceBranches
            $ D.Branch <<< ((flip D.setRepeatableOr r) <$>)
                       <<< D.runBranch
                       <$> bs

        expand arg = Map.singleton (key arg) arg

        resolveOR :: D.Argument -> D.Argument -> D.Argument
        resolveOR a b = D.setRepeatable a (D.isRepeatable a || D.isRepeatable b)

        resolveLCD :: D.Argument -> D.Argument -> D.Argument
        resolveLCD a b =  D.setRepeatable a true

    getValue :: Map Key D.Value -> D.Argument -> Maybe D.Value
    getValue vm a = do
      v <- Map.lookup (key a) vm
      return $ if D.isRepeatable a
                    then D.ArrayValue $ valIntoArray v
                    else v

    getFallback :: D.Argument -> Maybe D.Value
    getFallback a = getEnvValue a <|> getDefaultValue a

    getEnvValue :: D.Argument -> Maybe D.Value
    getEnvValue (D.Option (O.Option o@{ env: Just k }))
      = D.StringValue <$> Env.lookup k env
    getEnvValue _ = Nothing

    getDefaultValue :: D.Argument -> Maybe D.Value
    getDefaultValue (D.Option (O.Option o@{
        arg: Just (O.Argument { default: Just v })
      }))
      = return $
          if (D.isArrayValue v || not o.repeatable) then v
                                                    else D.ArrayValue [v]
    -- Handle option flags. Flags indicate only truthiness via their
    -- presence. Absent flags are always falsy!
    getDefaultValue (D.Option (O.Option o@{ arg: Nothing }))
      = return $ if o.repeatable then D.ArrayValue [ D.BoolValue false ]
                                 else D.BoolValue false
    getDefaultValue (D.Positional _ r)
      = if r then return $ D.ArrayValue []
             else Nothing
    getDefaultValue (D.Command _)
      = return $ D.BoolValue false
    getDefaultValue (D.EOA) = Just $ D.ArrayValue []
    getDefaultValue _ = Nothing

-- | Derive a key from an argument.
-- | This key is what the user will use to check the value of
-- | a mathed argument.
toKeys :: D.Argument -> Array String
toKeys (D.Command n)      = [n]
toKeys (D.Positional n _) = [ "<" ++ Str.toLower n ++ ">"
                            , Str.toUpper n
                            ]
toKeys (D.Group _ _ _)    = []
toKeys (D.EOA)            = ["--"]
toKeys (D.Stdin)          = ["-"]
toKeys (D.Option (O.Option o))
                          = []
                          ++ maybe [] (\c -> [ "-"  ++ fromChar c ]) o.flag
                          ++ maybe [] (\s -> [ "--" ++ s ]) o.name

module Language.Docopt.Trans (
  reduce
  ) where

import Prelude
import Debug.Trace
import Data.Maybe (Maybe(..), isJust, isNothing, maybe)
import Data.Foldable (foldl)
import Control.Plus (empty)
import Data.Bifunctor (lmap)
import Data.Array as A
import Data.StrMap as StrMap
import Data.StrMap (StrMap())
import Data.Map (Map())
import Data.String (fromChar)
import Data.Monoid (mempty)
import Data.Map as Map
import Data.String as Str
import Data.Tuple (Tuple(..), fst, snd)
import Control.MonadPlus (guard)
import Control.Alt ((<|>))
import Data.Function (on)
import Language.Docopt.Env (Env())
import Language.Docopt.Usage    as D
import Language.Docopt.Errors   as D
import Language.Docopt.Env      as D
import Language.Docopt.Value    as D
import Language.Docopt.Argument as D
import Language.Docopt.Option   as O
import Language.Docopt.Env      as Env
import Data.String.Ext ((^=))
import Data.List (List(..), toList, concat, singleton, groupBy, catMaybes)
import Data.List as L
import Language.Docopt.ParserGen.ValueMapping

newtype Key = Key { arg :: D.Argument }

instance showKey :: Show Key where
  show (Key { arg: (D.Option (O.Option o)) }) =
    maybe "" (\c -> fromChar c ++ ", ") o.flag
      ++ maybe "" id o.name
  show (Key { arg: (D.Positional n _) }) = n
  show (Key { arg: (D.Command n) }) = n
  show _ = "invalid" -- XXX

instance ordKey :: Ord Key where
  compare = compare `on` show -- XXX

instance eqKey :: Eq Key where
  eq (Key { arg: arg0 }) (Key { arg: arg1 }) = go arg0 arg1
    where
      go (D.Positional n _) (D.Positional n' _)
         = n ^= n'
      go (D.Option (O.Option { flag=f,  name=n  }))
         (D.Option (O.Option { flag=f', name=n' }))
         = (f == f') && (n == n')
      go (D.Command n) (D.Command n')
         = n == n'
      go a b = a == b

key :: D.Argument -> Key
key arg = Key { arg: arg }

-- | Reduce the list of (Argument, Value) mappings down to a Set of (String,
-- | Value), where `String` is the name of the argument.
-- |
-- | This reduction is "lossy" as it loses some of the rich information
-- | about the options that have been acquired. It also loses the information
-- | about the origin of the matched value as it could have been user-provded or
-- | derived from the option descriptions (default value, etc.).
-- |
-- | Despite the pitfalls, the reasons for adopting this are:
-- |
-- |   a) Compatibility with original docopt
-- |   b) Easy of use in JS-land. This step could implemented differently for
-- |      consumption in purescript (or any other language for that matter).
-- |
-- | A note on equality:
-- |    Options are considered equal if their names (or both of their aliases)
-- |    match. Modifiers such as repetitiveness or the arguments an option takes
-- |    are *NOT* considered for evaluating option equality.
-- |
reduce :: List D.Usage       -- ^ the program specification
       -> D.Env              -- ^ the environment
       -> D.Branch           -- ^ the matched specification
       -> List ValueMapping  -- ^ the parse result
       -> Map String D.Value -- ^ the output set of (arg => val)
reduce us env _ vs =
  let vm = Map.fromFoldableWith resolveArg $ lmap key <$> (prepare <$> vs)
      m  = reduceUsages us # applyValues vm
    in expandMap m
  where

    prepare :: ValueMapping -> ValueMapping
    prepare (Tuple a v) | D.isRepeatable a = Tuple a (D.ArrayValue $ valIntoArray v)
    prepare k = k

    expandMap :: Map Key D.Value -> Map String D.Value
    expandMap m = Map.fromFoldable $ concat
                    $ Map.toList m
                        <#> \(Tuple (Key { arg: a }) v) ->
                                flip Tuple v <$> (toList $ toKeys a)

    applyValues :: Map Key D.Value -> List D.Argument -> Map Key D.Value
    applyValues vm as = Map.fromFoldableWith resolveArg
      $ catMaybes
      $ as <#> \a -> Tuple (key a) <$> (getValue vm a <|> getFallback a)

    resolveArg :: D.Value -> D.Value -> D.Value
    resolveArg v v' = D.ArrayValue $ valIntoArray v' ++ valIntoArray v

    valIntoArray (D.ArrayValue xs)  = xs
    valIntoArray v                  = [v]

    reduceUsages :: List D.Usage -> List D.Argument
    reduceUsages us =
      let ms = reduceBranches <<< D.runUsage <$> us
       in Map.values $ foldl (Map.unionWith resolveLCD)
                             Map.empty
                             ms
      where
        reduceBranches :: List D.Branch -> Map Key D.Argument
        reduceBranches bs =
          let ms = combine <<< (expand <$>) <<< D.runBranch <$> bs
          in foldl (Map.unionWith resolveOR)
                    Map.empty
                    ms
          where
            combine :: List (Map Key D.Argument) -> Map Key D.Argument
            combine xs = foldl (Map.unionWith resolveLCD)
                              Map.empty
                              xs

        expand :: D.Argument -> Map Key D.Argument
        expand (D.Group _ bs r) =
          reduceBranches
            $ D.Branch <<< ((flip D.setRepeatableOr r) <$>)
                       <<< D.runBranch
                       <$> bs

        expand arg = Map.singleton (key arg) arg

        resolveOR :: D.Argument -> D.Argument -> D.Argument
        resolveOR a b = D.setRepeatable a (D.isRepeatable a || D.isRepeatable b)

        resolveLCD :: D.Argument -> D.Argument -> D.Argument
        resolveLCD a b =  D.setRepeatable a true

    getValue :: Map Key D.Value -> D.Argument -> Maybe D.Value
    getValue vm a = do
      v <- Map.lookup (key a) vm
      return $ if D.isRepeatable a
                    then D.ArrayValue $ valIntoArray v
                    else v

    getFallback :: D.Argument -> Maybe D.Value
    getFallback a = getEnvValue a <|> getDefaultValue a

    getEnvValue :: D.Argument -> Maybe D.Value
    getEnvValue (D.Option (O.Option o@{ env: Just k }))
      = D.StringValue <$> Env.lookup k env
    getEnvValue _ = Nothing

    getDefaultValue :: D.Argument -> Maybe D.Value
    getDefaultValue (D.Option (O.Option o@{
        arg: Just (O.Argument { default: Just v })
      }))
      = return $
          if (D.isArrayValue v || not o.repeatable) then v
                                                    else D.ArrayValue [v]
    -- Handle option flags. Flags indicate only truthiness via their
    -- presence. Absent flags are always falsy!
    getDefaultValue (D.Option (O.Option o@{ arg: Nothing }))
      = return $ if o.repeatable then D.ArrayValue [ D.BoolValue false ]
                                 else D.BoolValue false
    getDefaultValue (D.Positional _ r)
      = if r then return $ D.ArrayValue []
             else Nothing
    getDefaultValue (D.Command _)
      = return $ D.BoolValue false
    getDefaultValue (D.EOA) = Just $ D.ArrayValue []
    getDefaultValue _ = Nothing

-- | Derive a key from an argument.
-- | This key is what the user will use to check the value of
-- | a mathed argument.
toKeys :: D.Argument -> Array String
toKeys (D.Command n)      = [n]
toKeys (D.Positional n _) = [ "<" ++ Str.toLower n ++ ">"
                            , Str.toUpper n
                            ]
toKeys (D.Group _ _ _)    = []
toKeys (D.EOA)            = ["--"]
toKeys (D.Stdin)          = ["-"]
toKeys (D.Option (O.Option o))
                          = []
                          ++ maybe [] (\c -> [ "-"  ++ fromChar c ]) o.flag
                          ++ maybe [] (\s -> [ "--" ++ s ]) o.name


Fix shadowed name warning

Fix shadowed name warning

-- | Helper functions for working with immutable Javascript arrays.
-- |
-- | _Note_: Depending on your use-case, you may prefer to use `Data.List` or
-- | `Data.Sequence` instead, which might give better performance for certain
-- | use cases. This module is useful when integrating with JavaScript libraries
-- | which use arrays, but immutable arrays are not a practical data structure
-- | for many use cases due to their poor asymptotics.
-- |
-- | In addition to the functions in this module, Arrays have a number of
-- | useful instances:
-- |
-- | * `Functor`, which provides `map :: forall a b. (a -> b) -> Array a ->
-- |   Array b`
-- | * `Apply`, which provides `(<*>) :: forall a b. Array (a -> b) -> Array a
-- |   -> Array b`. This function works a bit like a Cartesian product; the
-- |   result array is constructed by applying each function in the first
-- |   array to each value in the second, so that the result array ends up with
-- |   a length equal to the product of the two arguments' lengths.
-- | * `Bind`, which provides `(>>=) :: forall a b. (a -> Array b) -> Array a
-- |   -> Array b` (this is the same as `concatMap`).
-- | * `Semigroup`, which provides `(<>) :: forall a. Array a -> Array a ->
-- |   Array a`, for concatenating arrays.
-- | * `Foldable`, which provides a slew of functions for *folding* (also known
-- |   as *reducing*) arrays down to one value. For example,
-- |   `Data.Foldable.or` tests whether an array of `Boolean` values contains
-- |   at least one `true` value.
-- | * `Traversable`, which provides the PureScript version of a for-loop,
-- |   allowing you to iterate over an array and accumulate effects.
-- |
module Data.Array
  ( fromFoldable
  , toUnfoldable
  , singleton
  , (..), range
  , replicate
  , some
  , many

  , null
  , length

  , (:), cons
  , snoc
  , insert
  , insertBy

  , head
  , last
  , tail
  , init
  , uncons

  , (!!), index
  , elemIndex
  , elemLastIndex
  , findIndex
  , findLastIndex
  , insertAt
  , deleteAt
  , updateAt
  , modifyAt
  , alterAt

  , reverse
  , concat
  , concatMap
  , filter
  , partition
  , filterM
  , mapMaybe
  , catMaybes
  , mapWithIndex

  , sort
  , sortBy

  , slice
  , take
  , takeWhile
  , drop
  , dropWhile
  , span
  , group
  , group'
  , groupBy

  , nub
  , nubBy
  , union
  , unionBy
  , delete
  , deleteBy

  , (\\), difference
  , intersect
  , intersectBy

  , zipWith
  , zipWithA
  , zip
  , unzip

  , foldM
  , foldRecM

  , unsafeIndex

  , module Exports
  ) where

import Prelude

import Control.Alt ((<|>))
import Control.Alternative (class Alternative)
import Control.Lazy (class Lazy, defer)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2)

import Data.Foldable (class Foldable, foldl, foldr)
import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports
import Data.Maybe (Maybe(..), maybe, isJust, fromJust)
import Data.NonEmpty (NonEmpty, (:|))
import Data.Traversable (scanl, scanr) as Exports
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (class Unfoldable, unfoldr)

import Partial.Unsafe (unsafePartial)

-- | Convert an `Array` into an `Unfoldable` structure.
toUnfoldable :: forall f a. Unfoldable f => Array a -> f a
toUnfoldable = unfoldr $ uncons' (const Nothing) (\h t -> Just (Tuple h t))

-- | Convert a `Foldable` structure into an `Array`.
fromFoldable :: forall f a. Foldable f => f a -> Array a
fromFoldable = fromFoldableImpl foldr

foreign import fromFoldableImpl
  :: forall f a
   . (forall b. (a -> b -> b) -> b -> f a -> b)
  -> f a
  -> Array a

-- | Create an array of one element
singleton :: forall a. a -> Array a
singleton a = [a]

-- | Create an array containing a range of integers, including both endpoints.
foreign import range :: Int -> Int -> Array Int

-- | Create an array containing a value repeated the specified number of times.
foreign import replicate :: forall a. Int -> a -> Array a

-- | An infix synonym for `range`.
infix 8 range as ..

-- | Attempt a computation multiple times, requiring at least one success.
-- |
-- | The `Lazy` constraint is used to generate the result lazily, to ensure
-- | termination.
some :: forall f a. (Alternative f, Lazy (f (Array a))) => f a -> f (Array a)
some v = (:) <$> v <*> defer (\_ -> many v)

-- | Attempt a computation multiple times, returning as many successful results
-- | as possible (possibly zero).
-- |
-- | The `Lazy` constraint is used to generate the result lazily, to ensure
-- | termination.
many :: forall f a. (Alternative f, Lazy (f (Array a))) => f a -> f (Array a)
many v = some v <|> pure []

--------------------------------------------------------------------------------
-- Array size ------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Test whether an array is empty.
null :: forall a. Array a -> Boolean
null xs = length xs == 0

-- | Get the number of elements in an array.
foreign import length :: forall a. Array a -> Int

--------------------------------------------------------------------------------
-- Extending arrays ------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Attaches an element to the front of an array, creating a new array.
-- |
-- | ```purescript
-- | cons 1 [2, 3, 4] = [1, 2, 3, 4]
-- | ```
-- |
-- | Note, the running time of this function is `O(n)`.
foreign import cons :: forall a. a -> Array a -> Array a

-- | An infix alias for `cons`.
-- |
-- | Note, the running time of this function is `O(n)`.
infixr 6 cons as :

-- | Append an element to the end of an array, creating a new array.
foreign import snoc :: forall a. Array a -> a -> Array a

-- | Insert an element into a sorted array.
insert :: forall a. Ord a => a -> Array a -> Array a
insert = insertBy compare

-- | Insert an element into a sorted array, using the specified function to
-- | determine the ordering of elements.
insertBy :: forall a. (a -> a -> Ordering) -> a -> Array a -> Array a
insertBy cmp x ys =
  let i = maybe 0 (_ + 1) (findLastIndex (\y -> cmp x y == GT) ys)
  in unsafePartial (fromJust (insertAt i x ys))

--------------------------------------------------------------------------------
-- Non-indexed reads -----------------------------------------------------------
--------------------------------------------------------------------------------

-- | Get the first element in an array, or `Nothing` if the array is empty
-- |
-- | Running time: `O(1)`.
head :: forall a. Array a -> Maybe a
head = uncons' (const Nothing) (\x _ -> Just x)

-- | Get the last element in an array, or `Nothing` if the array is empty
-- |
-- | Running time: `O(1)`.
last :: forall a. Array a -> Maybe a
last xs = xs !! (length xs - 1)

-- | Get all but the first element of an array, creating a new array, or
-- | `Nothing` if the array is empty
-- |
-- | Running time: `O(n)` where `n` is the length of the array
tail :: forall a. Array a -> Maybe (Array a)
tail = uncons' (const Nothing) (\_ xs -> Just xs)

-- | Get all but the last element of an array, creating a new array, or
-- | `Nothing` if the array is empty.
-- |
-- | Running time: `O(n)` where `n` is the length of the array
init :: forall a. Array a -> Maybe (Array a)
init xs
  | null xs = Nothing
  | otherwise = Just (slice zero (length xs - one) xs)

-- | Break an array into its first element and remaining elements.
-- |
-- | Using `uncons` provides a way of writing code that would use cons patterns
-- | in Haskell or pre-PureScript 0.7:
-- | ``` purescript
-- | f (x : xs) = something
-- | f [] = somethingElse
-- | ```
-- | Becomes:
-- | ``` purescript
-- | f arr = case uncons arr of
-- |   Just { head: x, tail: xs } -> something
-- |   Nothing -> somethingElse
-- | ```
uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a }
uncons = uncons' (const Nothing) \x xs -> Just { head: x, tail: xs }

foreign import uncons'
  :: forall a b
   . (Unit -> b)
  -> (a -> Array a -> b)
  -> Array a
  -> b

--------------------------------------------------------------------------------
-- Indexed operations ----------------------------------------------------------
--------------------------------------------------------------------------------

-- | This function provides a safe way to read a value at a particular index
-- | from an array.
index :: forall a. Array a -> Int -> Maybe a
index = indexImpl Just Nothing

foreign import indexImpl
  :: forall a
   . (forall r. r -> Maybe r)
  -> (forall r. Maybe r)
  -> Array a
  -> Int
  -> Maybe a

-- | An infix version of `index`.
infixl 8 index as !!

-- | Find the index of the first element equal to the specified element.
elemIndex :: forall a. Eq a => a -> Array a -> Maybe Int
elemIndex x = findIndex (_ == x)

-- | Find the index of the last element equal to the specified element.
elemLastIndex :: forall a. Eq a => a -> Array a -> Maybe Int
elemLastIndex x = findLastIndex (_ == x)

-- | Find the first index for which a predicate holds.
findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int
findIndex = findIndexImpl Just Nothing

foreign import findIndexImpl
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> (a -> Boolean)
  -> Array a
  -> Maybe Int

-- | Find the last index for which a predicate holds.
findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int
findLastIndex = findLastIndexImpl Just Nothing

foreign import findLastIndexImpl
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> (a -> Boolean)
  -> Array a
  -> Maybe Int

-- | Insert an element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a)
insertAt = _insertAt Just Nothing

foreign import _insertAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> a
  -> Array a
  -> Maybe (Array a)

-- | Delete the element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
deleteAt :: forall a. Int -> Array a -> Maybe (Array a)
deleteAt = _deleteAt Just Nothing

foreign import _deleteAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> Array a
  -> Maybe (Array a)

-- | Change the element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a)
updateAt = _updateAt Just Nothing

foreign import _updateAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> a
  -> Array a
  -> Maybe (Array a)

-- | Apply a function to the element at the specified index, creating a new
-- | array, or returning `Nothing` if the index is out of bounds.
modifyAt :: forall a. Int -> (a -> a) -> Array a -> Maybe (Array a)
modifyAt i f xs = maybe Nothing go (xs !! i)
  where
  go x = updateAt i (f x) xs

-- | Update or delete the element at the specified index by applying a
-- | function to the current value, returning a new array or `Nothing` if the
-- | index is out-of-bounds.
alterAt :: forall a. Int -> (a -> Maybe a) -> Array a -> Maybe (Array a)
alterAt i f xs = maybe Nothing go (xs !! i)
  where
  go x = case f x of
    Nothing -> deleteAt i xs
    Just x' -> updateAt i x' xs

--------------------------------------------------------------------------------
-- Transformations -------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Reverse an array, creating a new array.
foreign import reverse :: forall a. Array a -> Array a

-- | Flatten an array of arrays, creating a new array.
foreign import concat :: forall a. Array (Array a) -> Array a

-- | Apply a function to each element in an array, and flatten the results
-- | into a single, new array.
concatMap :: forall a b. (a -> Array b) -> Array a -> Array b
concatMap = flip bind

-- | Filter an array, keeping the elements which satisfy a predicate function,
-- | creating a new array.
foreign import filter :: forall a. (a -> Boolean) -> Array a -> Array a

-- | Partition an array using a predicate function, creating a set of
-- | new arrays. One for the values satisfying the predicate function
-- | and one for values that don't.
foreign import partition
  :: forall a
   . (a -> Boolean)
  -> Array a
  -> { yes :: Array a, no :: Array a }

-- | Filter where the predicate returns a monadic `Boolean`.
-- |
-- | ```purescript
-- | powerSet :: forall a. [a] -> [[a]]
-- | powerSet = filterM (const [true, false])
-- | ```
filterM :: forall a m. Monad m => (a -> m Boolean) -> Array a -> m (Array a)
filterM p = uncons' (\_ -> pure []) \x xs -> do
  b <- p x
  xs' <- filterM p xs
  pure if b then x : xs' else xs'

-- | Apply a function to each element in an array, keeping only the results
-- | which contain a value, creating a new array.
mapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b
mapMaybe f = concatMap (maybe [] singleton <<< f)

-- | Filter an array of optional values, keeping only the elements which contain
-- | a value, creating a new array.
catMaybes :: forall a. Array (Maybe a) -> Array a
catMaybes = mapMaybe id

-- | Apply a function to each element in an array, supplying a generated
-- | zero-based index integer along with the element, creating an array
-- | with the new elements.
mapWithIndex :: forall a b. (Int -> a -> b) -> Array a -> Array b
mapWithIndex f xs =
  zipWith f (range 0 (length xs - 1)) xs

--------------------------------------------------------------------------------
-- Sorting ---------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Sort the elements of an array in increasing order, creating a new array.
sort :: forall a. Ord a => Array a -> Array a
sort xs = sortBy compare xs

-- | Sort the elements of an array in increasing order, where elements are
-- | compared using the specified partial ordering, creating a new array.
sortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a
sortBy comp xs = sortImpl comp' xs
  where
  comp' x y = case comp x y of
    GT -> 1
    EQ -> 0
    LT -> -1

foreign import sortImpl :: forall a. (a -> a -> Int) -> Array a -> Array a

--------------------------------------------------------------------------------
-- Subarrays -------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Extract a subarray by a start and end index.
foreign import slice :: forall a. Int -> Int -> Array a -> Array a

-- | Keep only a number of elements from the start of an array, creating a new
-- | array.
foreign import take :: forall a. Int -> Array a -> Array a

-- | Calculate the longest initial subarray for which all element satisfy the
-- | specified predicate, creating a new array.
takeWhile :: forall a. (a -> Boolean) -> Array a -> Array a
takeWhile p xs = (span p xs).init

-- | Drop a number of elements from the start of an array, creating a new array.
foreign import drop :: forall a. Int -> Array a -> Array a

-- | Remove the longest initial subarray for which all element satisfy the
-- | specified predicate, creating a new array.
dropWhile :: forall a. (a -> Boolean) -> Array a -> Array a
dropWhile p xs = (span p xs).rest

-- | Split an array into two parts:
-- |
-- | 1. the longest initial subarray for which all element satisfy the specified
-- |    predicate
-- | 2. the remaining elements
-- |
-- | ```purescript
-- | span (\n -> n % 2 == 1) [1,3,2,4,5] == { init: [1,3], rest: [2,4,5] }
-- | ```
span
  :: forall a
   . (a -> Boolean)
  -> Array a
  -> { init :: Array a, rest :: Array a }
span p = go []
  where
  go :: Array a -> Array a -> { init :: Array a, rest :: Array a }
  go acc xs =
    case uncons xs of
      Just { head: x, tail: xs' } | p x -> go (x : acc) xs'
      _ -> { init: reverse acc, rest: xs }

-- | Group equal, consecutive elements of an array into arrays.
-- |
-- | ```purescript
-- | group [1,1,2,2,1] == [[1,1],[2,2],[1]]
-- | ```
group :: forall a. Eq a => Array a -> Array (NonEmpty Array a)
group xs = groupBy eq xs

-- | Sort and then group the elements of an array into arrays.
-- |
-- | ```purescript
-- | group' [1,1,2,2,1] == [[1,1,1],[2,2]]
-- | ```
group' :: forall a. Ord a => Array a -> Array (NonEmpty Array a)
group' = group <<< sort

-- | Group equal, consecutive elements of an array into arrays, using the
-- | specified equivalence relation to detemine equality.
groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmpty Array a)
groupBy op = go []
  where
  go :: Array (NonEmpty Array a) -> Array a -> Array (NonEmpty Array a)
  go acc xs = case uncons xs of
    Just o ->
      let sp = span (op o.head) o.tail
      in go ((o.head :| sp.init) : acc) sp.rest
    Nothing -> reverse acc

-- | Remove the duplicates from an array, creating a new array.
nub :: forall a. Eq a => Array a -> Array a
nub = nubBy eq

-- | Remove the duplicates from an array, where element equality is determined
-- | by the specified equivalence relation, creating a new array.
nubBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a
nubBy eq xs =
  case uncons xs of
    Just o -> o.head : nubBy eq (filter (\y -> not (o.head `eq` y)) o.tail)
    Nothing -> []

-- | Calculate the union of two arrays. Note that duplicates in the first array
-- | are preserved while duplicates in the second array are removed.
-- |
-- | Running time: `O(n^2)`
union :: forall a. Eq a => Array a -> Array a -> Array a
union = unionBy (==)

-- | Calculate the union of two arrays, using the specified function to
-- | determine equality of elements. Note that duplicates in the first array
-- | are preserved while duplicates in the second array are removed.
unionBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a
unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubBy eq ys) xs

-- | Delete the first element of an array which is equal to the specified value,
-- | creating a new array.
delete :: forall a. Eq a => a -> Array a -> Array a
delete = deleteBy eq

-- | Delete the first element of an array which matches the specified value,
-- | under the equivalence relation provided in the first argument, creating a
-- | new array.
deleteBy :: forall a. (a -> a -> Boolean) -> a -> Array a -> Array a
deleteBy _  _ [] = []
deleteBy eq x ys = maybe ys (\i -> unsafePartial $ fromJust (deleteAt i ys)) (findIndex (eq x) ys)

-- | Delete the first occurrence of each element in the second array from the
-- | first array, creating a new array.
difference :: forall a. Eq a => Array a -> Array a -> Array a
difference xs ys
  | null xs = []
  | otherwise = uncons' (const xs) (\z zs -> delete z xs \\ zs) ys

infix 5 difference as \\

-- | Calculate the intersection of two arrays, creating a new array. Note that
-- | duplicates in the first array are preserved while duplicates in the second
-- | array are removed.
intersect :: forall a. Eq a => Array a -> Array a -> Array a
intersect = intersectBy eq

-- | Calculate the intersection of two arrays, using the specified equivalence
-- | relation to compare elements, creating a new array. Note that duplicates
-- | in the first array are preserved while duplicates in the second array are
-- | removed.
intersectBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a
intersectBy eq xs ys = filter (\x -> isJust (findIndex (eq x) ys)) xs

-- | Apply a function to pairs of elements at the same index in two arrays,
-- | collecting the results in a new array.
-- |
-- | If one array is longer, elements will be discarded from the longer array.
-- |
-- | For example
-- |
-- | ```purescript
-- | zipWith (*) [1, 2, 3] [4, 5, 6, 7] == [4, 10, 18]
-- | ```
foreign import zipWith
  :: forall a b c
   . (a -> b -> c)
  -> Array a
  -> Array b
  -> Array c

-- | A generalization of `zipWith` which accumulates results in some
-- | `Applicative` functor.
zipWithA
  :: forall m a b c
   . Applicative m
  => (a -> b -> m c)
  -> Array a
  -> Array b
  -> m (Array c)
zipWithA f xs ys = sequence (zipWith f xs ys)

-- | Rakes two lists and returns a list of corresponding pairs.
-- | If one input list is short, excess elements of the longer list are
-- | discarded.
zip :: forall a b. Array a -> Array b -> Array (Tuple a b)
zip = zipWith Tuple

-- | Transforms a list of pairs into a list of first components and a list of
-- | second components.
unzip :: forall a b. Array (Tuple a b) -> Tuple (Array a) (Array b)
unzip = uncons' (\_ -> Tuple [] []) \(Tuple a b) ts -> case unzip ts of
  Tuple as bs -> Tuple (a : as) (b : bs)

-- | Perform a fold using a monadic step function.
foldM :: forall m a b. Monad m => (a -> b -> m a) -> a -> Array b -> m a
foldM f a = uncons' (\_ -> pure a) (\b bs -> f a b >>= \a' -> foldM f a' bs)

foldRecM :: forall m a b. MonadRec m => (a -> b -> m a) -> a -> Array b -> m a
foldRecM f a array = tailRecM2 go a 0
  where
  go res i
    | i >= length array = pure (Done res)
    | otherwise = do
        res' <- f res (unsafePartial (unsafeIndex array i))
        pure (Loop { a: res', b: i + 1 })

-- | Find the element of an array at the specified index.
unsafeIndex :: forall a. Partial => Array a -> Int -> a
unsafeIndex = unsafeIndexImpl

foreign import unsafeIndexImpl :: forall a. Array a -> Int -> a

-- | Helper functions for working with immutable Javascript arrays.
-- |
-- | _Note_: Depending on your use-case, you may prefer to use `Data.List` or
-- | `Data.Sequence` instead, which might give better performance for certain
-- | use cases. This module is useful when integrating with JavaScript libraries
-- | which use arrays, but immutable arrays are not a practical data structure
-- | for many use cases due to their poor asymptotics.
-- |
-- | In addition to the functions in this module, Arrays have a number of
-- | useful instances:
-- |
-- | * `Functor`, which provides `map :: forall a b. (a -> b) -> Array a ->
-- |   Array b`
-- | * `Apply`, which provides `(<*>) :: forall a b. Array (a -> b) -> Array a
-- |   -> Array b`. This function works a bit like a Cartesian product; the
-- |   result array is constructed by applying each function in the first
-- |   array to each value in the second, so that the result array ends up with
-- |   a length equal to the product of the two arguments' lengths.
-- | * `Bind`, which provides `(>>=) :: forall a b. (a -> Array b) -> Array a
-- |   -> Array b` (this is the same as `concatMap`).
-- | * `Semigroup`, which provides `(<>) :: forall a. Array a -> Array a ->
-- |   Array a`, for concatenating arrays.
-- | * `Foldable`, which provides a slew of functions for *folding* (also known
-- |   as *reducing*) arrays down to one value. For example,
-- |   `Data.Foldable.or` tests whether an array of `Boolean` values contains
-- |   at least one `true` value.
-- | * `Traversable`, which provides the PureScript version of a for-loop,
-- |   allowing you to iterate over an array and accumulate effects.
-- |
module Data.Array
  ( fromFoldable
  , toUnfoldable
  , singleton
  , (..), range
  , replicate
  , some
  , many

  , null
  , length

  , (:), cons
  , snoc
  , insert
  , insertBy

  , head
  , last
  , tail
  , init
  , uncons

  , (!!), index
  , elemIndex
  , elemLastIndex
  , findIndex
  , findLastIndex
  , insertAt
  , deleteAt
  , updateAt
  , modifyAt
  , alterAt

  , reverse
  , concat
  , concatMap
  , filter
  , partition
  , filterM
  , mapMaybe
  , catMaybes
  , mapWithIndex

  , sort
  , sortBy

  , slice
  , take
  , takeWhile
  , drop
  , dropWhile
  , span
  , group
  , group'
  , groupBy

  , nub
  , nubBy
  , union
  , unionBy
  , delete
  , deleteBy

  , (\\), difference
  , intersect
  , intersectBy

  , zipWith
  , zipWithA
  , zip
  , unzip

  , foldM
  , foldRecM

  , unsafeIndex

  , module Exports
  ) where

import Prelude

import Control.Alt ((<|>))
import Control.Alternative (class Alternative)
import Control.Lazy (class Lazy, defer)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2)

import Data.Foldable (class Foldable, foldl, foldr)
import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports
import Data.Maybe (Maybe(..), maybe, isJust, fromJust)
import Data.NonEmpty (NonEmpty, (:|))
import Data.Traversable (scanl, scanr) as Exports
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (class Unfoldable, unfoldr)

import Partial.Unsafe (unsafePartial)

-- | Convert an `Array` into an `Unfoldable` structure.
toUnfoldable :: forall f a. Unfoldable f => Array a -> f a
toUnfoldable = unfoldr $ uncons' (const Nothing) (\h t -> Just (Tuple h t))

-- | Convert a `Foldable` structure into an `Array`.
fromFoldable :: forall f a. Foldable f => f a -> Array a
fromFoldable = fromFoldableImpl foldr

foreign import fromFoldableImpl
  :: forall f a
   . (forall b. (a -> b -> b) -> b -> f a -> b)
  -> f a
  -> Array a

-- | Create an array of one element
singleton :: forall a. a -> Array a
singleton a = [a]

-- | Create an array containing a range of integers, including both endpoints.
foreign import range :: Int -> Int -> Array Int

-- | Create an array containing a value repeated the specified number of times.
foreign import replicate :: forall a. Int -> a -> Array a

-- | An infix synonym for `range`.
infix 8 range as ..

-- | Attempt a computation multiple times, requiring at least one success.
-- |
-- | The `Lazy` constraint is used to generate the result lazily, to ensure
-- | termination.
some :: forall f a. (Alternative f, Lazy (f (Array a))) => f a -> f (Array a)
some v = (:) <$> v <*> defer (\_ -> many v)

-- | Attempt a computation multiple times, returning as many successful results
-- | as possible (possibly zero).
-- |
-- | The `Lazy` constraint is used to generate the result lazily, to ensure
-- | termination.
many :: forall f a. (Alternative f, Lazy (f (Array a))) => f a -> f (Array a)
many v = some v <|> pure []

--------------------------------------------------------------------------------
-- Array size ------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Test whether an array is empty.
null :: forall a. Array a -> Boolean
null xs = length xs == 0

-- | Get the number of elements in an array.
foreign import length :: forall a. Array a -> Int

--------------------------------------------------------------------------------
-- Extending arrays ------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Attaches an element to the front of an array, creating a new array.
-- |
-- | ```purescript
-- | cons 1 [2, 3, 4] = [1, 2, 3, 4]
-- | ```
-- |
-- | Note, the running time of this function is `O(n)`.
foreign import cons :: forall a. a -> Array a -> Array a

-- | An infix alias for `cons`.
-- |
-- | Note, the running time of this function is `O(n)`.
infixr 6 cons as :

-- | Append an element to the end of an array, creating a new array.
foreign import snoc :: forall a. Array a -> a -> Array a

-- | Insert an element into a sorted array.
insert :: forall a. Ord a => a -> Array a -> Array a
insert = insertBy compare

-- | Insert an element into a sorted array, using the specified function to
-- | determine the ordering of elements.
insertBy :: forall a. (a -> a -> Ordering) -> a -> Array a -> Array a
insertBy cmp x ys =
  let i = maybe 0 (_ + 1) (findLastIndex (\y -> cmp x y == GT) ys)
  in unsafePartial (fromJust (insertAt i x ys))

--------------------------------------------------------------------------------
-- Non-indexed reads -----------------------------------------------------------
--------------------------------------------------------------------------------

-- | Get the first element in an array, or `Nothing` if the array is empty
-- |
-- | Running time: `O(1)`.
head :: forall a. Array a -> Maybe a
head = uncons' (const Nothing) (\x _ -> Just x)

-- | Get the last element in an array, or `Nothing` if the array is empty
-- |
-- | Running time: `O(1)`.
last :: forall a. Array a -> Maybe a
last xs = xs !! (length xs - 1)

-- | Get all but the first element of an array, creating a new array, or
-- | `Nothing` if the array is empty
-- |
-- | Running time: `O(n)` where `n` is the length of the array
tail :: forall a. Array a -> Maybe (Array a)
tail = uncons' (const Nothing) (\_ xs -> Just xs)

-- | Get all but the last element of an array, creating a new array, or
-- | `Nothing` if the array is empty.
-- |
-- | Running time: `O(n)` where `n` is the length of the array
init :: forall a. Array a -> Maybe (Array a)
init xs
  | null xs = Nothing
  | otherwise = Just (slice zero (length xs - one) xs)

-- | Break an array into its first element and remaining elements.
-- |
-- | Using `uncons` provides a way of writing code that would use cons patterns
-- | in Haskell or pre-PureScript 0.7:
-- | ``` purescript
-- | f (x : xs) = something
-- | f [] = somethingElse
-- | ```
-- | Becomes:
-- | ``` purescript
-- | f arr = case uncons arr of
-- |   Just { head: x, tail: xs } -> something
-- |   Nothing -> somethingElse
-- | ```
uncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a }
uncons = uncons' (const Nothing) \x xs -> Just { head: x, tail: xs }

foreign import uncons'
  :: forall a b
   . (Unit -> b)
  -> (a -> Array a -> b)
  -> Array a
  -> b

--------------------------------------------------------------------------------
-- Indexed operations ----------------------------------------------------------
--------------------------------------------------------------------------------

-- | This function provides a safe way to read a value at a particular index
-- | from an array.
index :: forall a. Array a -> Int -> Maybe a
index = indexImpl Just Nothing

foreign import indexImpl
  :: forall a
   . (forall r. r -> Maybe r)
  -> (forall r. Maybe r)
  -> Array a
  -> Int
  -> Maybe a

-- | An infix version of `index`.
infixl 8 index as !!

-- | Find the index of the first element equal to the specified element.
elemIndex :: forall a. Eq a => a -> Array a -> Maybe Int
elemIndex x = findIndex (_ == x)

-- | Find the index of the last element equal to the specified element.
elemLastIndex :: forall a. Eq a => a -> Array a -> Maybe Int
elemLastIndex x = findLastIndex (_ == x)

-- | Find the first index for which a predicate holds.
findIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int
findIndex = findIndexImpl Just Nothing

foreign import findIndexImpl
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> (a -> Boolean)
  -> Array a
  -> Maybe Int

-- | Find the last index for which a predicate holds.
findLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int
findLastIndex = findLastIndexImpl Just Nothing

foreign import findLastIndexImpl
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> (a -> Boolean)
  -> Array a
  -> Maybe Int

-- | Insert an element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
insertAt :: forall a. Int -> a -> Array a -> Maybe (Array a)
insertAt = _insertAt Just Nothing

foreign import _insertAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> a
  -> Array a
  -> Maybe (Array a)

-- | Delete the element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
deleteAt :: forall a. Int -> Array a -> Maybe (Array a)
deleteAt = _deleteAt Just Nothing

foreign import _deleteAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> Array a
  -> Maybe (Array a)

-- | Change the element at the specified index, creating a new array, or
-- | returning `Nothing` if the index is out of bounds.
updateAt :: forall a. Int -> a -> Array a -> Maybe (Array a)
updateAt = _updateAt Just Nothing

foreign import _updateAt
  :: forall a
   . (forall b. b -> Maybe b)
  -> (forall b. Maybe b)
  -> Int
  -> a
  -> Array a
  -> Maybe (Array a)

-- | Apply a function to the element at the specified index, creating a new
-- | array, or returning `Nothing` if the index is out of bounds.
modifyAt :: forall a. Int -> (a -> a) -> Array a -> Maybe (Array a)
modifyAt i f xs = maybe Nothing go (xs !! i)
  where
  go x = updateAt i (f x) xs

-- | Update or delete the element at the specified index by applying a
-- | function to the current value, returning a new array or `Nothing` if the
-- | index is out-of-bounds.
alterAt :: forall a. Int -> (a -> Maybe a) -> Array a -> Maybe (Array a)
alterAt i f xs = maybe Nothing go (xs !! i)
  where
  go x = case f x of
    Nothing -> deleteAt i xs
    Just x' -> updateAt i x' xs

--------------------------------------------------------------------------------
-- Transformations -------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Reverse an array, creating a new array.
foreign import reverse :: forall a. Array a -> Array a

-- | Flatten an array of arrays, creating a new array.
foreign import concat :: forall a. Array (Array a) -> Array a

-- | Apply a function to each element in an array, and flatten the results
-- | into a single, new array.
concatMap :: forall a b. (a -> Array b) -> Array a -> Array b
concatMap = flip bind

-- | Filter an array, keeping the elements which satisfy a predicate function,
-- | creating a new array.
foreign import filter :: forall a. (a -> Boolean) -> Array a -> Array a

-- | Partition an array using a predicate function, creating a set of
-- | new arrays. One for the values satisfying the predicate function
-- | and one for values that don't.
foreign import partition
  :: forall a
   . (a -> Boolean)
  -> Array a
  -> { yes :: Array a, no :: Array a }

-- | Filter where the predicate returns a monadic `Boolean`.
-- |
-- | ```purescript
-- | powerSet :: forall a. [a] -> [[a]]
-- | powerSet = filterM (const [true, false])
-- | ```
filterM :: forall a m. Monad m => (a -> m Boolean) -> Array a -> m (Array a)
filterM p = uncons' (\_ -> pure []) \x xs -> do
  b <- p x
  xs' <- filterM p xs
  pure if b then x : xs' else xs'

-- | Apply a function to each element in an array, keeping only the results
-- | which contain a value, creating a new array.
mapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b
mapMaybe f = concatMap (maybe [] singleton <<< f)

-- | Filter an array of optional values, keeping only the elements which contain
-- | a value, creating a new array.
catMaybes :: forall a. Array (Maybe a) -> Array a
catMaybes = mapMaybe id

-- | Apply a function to each element in an array, supplying a generated
-- | zero-based index integer along with the element, creating an array
-- | with the new elements.
mapWithIndex :: forall a b. (Int -> a -> b) -> Array a -> Array b
mapWithIndex f xs =
  zipWith f (range 0 (length xs - 1)) xs

--------------------------------------------------------------------------------
-- Sorting ---------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Sort the elements of an array in increasing order, creating a new array.
sort :: forall a. Ord a => Array a -> Array a
sort xs = sortBy compare xs

-- | Sort the elements of an array in increasing order, where elements are
-- | compared using the specified partial ordering, creating a new array.
sortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a
sortBy comp xs = sortImpl comp' xs
  where
  comp' x y = case comp x y of
    GT -> 1
    EQ -> 0
    LT -> -1

foreign import sortImpl :: forall a. (a -> a -> Int) -> Array a -> Array a

--------------------------------------------------------------------------------
-- Subarrays -------------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Extract a subarray by a start and end index.
foreign import slice :: forall a. Int -> Int -> Array a -> Array a

-- | Keep only a number of elements from the start of an array, creating a new
-- | array.
foreign import take :: forall a. Int -> Array a -> Array a

-- | Calculate the longest initial subarray for which all element satisfy the
-- | specified predicate, creating a new array.
takeWhile :: forall a. (a -> Boolean) -> Array a -> Array a
takeWhile p xs = (span p xs).init

-- | Drop a number of elements from the start of an array, creating a new array.
foreign import drop :: forall a. Int -> Array a -> Array a

-- | Remove the longest initial subarray for which all element satisfy the
-- | specified predicate, creating a new array.
dropWhile :: forall a. (a -> Boolean) -> Array a -> Array a
dropWhile p xs = (span p xs).rest

-- | Split an array into two parts:
-- |
-- | 1. the longest initial subarray for which all element satisfy the specified
-- |    predicate
-- | 2. the remaining elements
-- |
-- | ```purescript
-- | span (\n -> n % 2 == 1) [1,3,2,4,5] == { init: [1,3], rest: [2,4,5] }
-- | ```
span
  :: forall a
   . (a -> Boolean)
  -> Array a
  -> { init :: Array a, rest :: Array a }
span p = go []
  where
  go :: Array a -> Array a -> { init :: Array a, rest :: Array a }
  go acc xs =
    case uncons xs of
      Just { head: x, tail: xs } | p x -> go (x : acc) xs
      _ -> { init: reverse acc, rest: xs }

-- | Group equal, consecutive elements of an array into arrays.
-- |
-- | ```purescript
-- | group [1,1,2,2,1] == [[1,1],[2,2],[1]]
-- | ```
group :: forall a. Eq a => Array a -> Array (NonEmpty Array a)
group xs = groupBy eq xs

-- | Sort and then group the elements of an array into arrays.
-- |
-- | ```purescript
-- | group' [1,1,2,2,1] == [[1,1,1],[2,2]]
-- | ```
group' :: forall a. Ord a => Array a -> Array (NonEmpty Array a)
group' = group <<< sort

-- | Group equal, consecutive elements of an array into arrays, using the
-- | specified equivalence relation to detemine equality.
groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmpty Array a)
groupBy op = go []
  where
  go :: Array (NonEmpty Array a) -> Array a -> Array (NonEmpty Array a)
  go acc xs = case uncons xs of
    Just o ->
      let sp = span (op o.head) o.tail
      in go ((o.head :| sp.init) : acc) sp.rest
    Nothing -> reverse acc

-- | Remove the duplicates from an array, creating a new array.
nub :: forall a. Eq a => Array a -> Array a
nub = nubBy eq

-- | Remove the duplicates from an array, where element equality is determined
-- | by the specified equivalence relation, creating a new array.
nubBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a
nubBy eq xs =
  case uncons xs of
    Just o -> o.head : nubBy eq (filter (\y -> not (o.head `eq` y)) o.tail)
    Nothing -> []

-- | Calculate the union of two arrays. Note that duplicates in the first array
-- | are preserved while duplicates in the second array are removed.
-- |
-- | Running time: `O(n^2)`
union :: forall a. Eq a => Array a -> Array a -> Array a
union = unionBy (==)

-- | Calculate the union of two arrays, using the specified function to
-- | determine equality of elements. Note that duplicates in the first array
-- | are preserved while duplicates in the second array are removed.
unionBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a
unionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubBy eq ys) xs

-- | Delete the first element of an array which is equal to the specified value,
-- | creating a new array.
delete :: forall a. Eq a => a -> Array a -> Array a
delete = deleteBy eq

-- | Delete the first element of an array which matches the specified value,
-- | under the equivalence relation provided in the first argument, creating a
-- | new array.
deleteBy :: forall a. (a -> a -> Boolean) -> a -> Array a -> Array a
deleteBy _  _ [] = []
deleteBy eq x ys = maybe ys (\i -> unsafePartial $ fromJust (deleteAt i ys)) (findIndex (eq x) ys)

-- | Delete the first occurrence of each element in the second array from the
-- | first array, creating a new array.
difference :: forall a. Eq a => Array a -> Array a -> Array a
difference xs ys
  | null xs = []
  | otherwise = uncons' (const xs) (\z zs -> delete z xs \\ zs) ys

infix 5 difference as \\

-- | Calculate the intersection of two arrays, creating a new array. Note that
-- | duplicates in the first array are preserved while duplicates in the second
-- | array are removed.
intersect :: forall a. Eq a => Array a -> Array a -> Array a
intersect = intersectBy eq

-- | Calculate the intersection of two arrays, using the specified equivalence
-- | relation to compare elements, creating a new array. Note that duplicates
-- | in the first array are preserved while duplicates in the second array are
-- | removed.
intersectBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a
intersectBy eq xs ys = filter (\x -> isJust (findIndex (eq x) ys)) xs

-- | Apply a function to pairs of elements at the same index in two arrays,
-- | collecting the results in a new array.
-- |
-- | If one array is longer, elements will be discarded from the longer array.
-- |
-- | For example
-- |
-- | ```purescript
-- | zipWith (*) [1, 2, 3] [4, 5, 6, 7] == [4, 10, 18]
-- | ```
foreign import zipWith
  :: forall a b c
   . (a -> b -> c)
  -> Array a
  -> Array b
  -> Array c

-- | A generalization of `zipWith` which accumulates results in some
-- | `Applicative` functor.
zipWithA
  :: forall m a b c
   . Applicative m
  => (a -> b -> m c)
  -> Array a
  -> Array b
  -> m (Array c)
zipWithA f xs ys = sequence (zipWith f xs ys)

-- | Rakes two lists and returns a list of corresponding pairs.
-- | If one input list is short, excess elements of the longer list are
-- | discarded.
zip :: forall a b. Array a -> Array b -> Array (Tuple a b)
zip = zipWith Tuple

-- | Transforms a list of pairs into a list of first components and a list of
-- | second components.
unzip :: forall a b. Array (Tuple a b) -> Tuple (Array a) (Array b)
unzip = uncons' (\_ -> Tuple [] []) \(Tuple a b) ts -> case unzip ts of
  Tuple as bs -> Tuple (a : as) (b : bs)

-- | Perform a fold using a monadic step function.
foldM :: forall m a b. Monad m => (a -> b -> m a) -> a -> Array b -> m a
foldM f a = uncons' (\_ -> pure a) (\b bs -> f a b >>= \a' -> foldM f a' bs)

foldRecM :: forall m a b. MonadRec m => (a -> b -> m a) -> a -> Array b -> m a
foldRecM f a array = tailRecM2 go a 0
  where
  go res i
    | i >= length array = pure (Done res)
    | otherwise = do
        res' <- f res (unsafePartial (unsafeIndex array i))
        pure (Loop { a: res', b: i + 1 })

-- | Find the element of an array at the specified index.
unsafeIndex :: forall a. Partial => Array a -> Int -> a
unsafeIndex = unsafeIndexImpl

foreign import unsafeIndexImpl :: forall a. Array a -> Int -> a


Update InfiniteList.purs

Update InfiniteList.purs

module Data.InfiniteList
  ( InfiniteList
  , iterate
  , repeat
  , take
  , drop
  , takeWhile
  , dropWhile
  , head
  , tail
  , zip
  ) where

import Data.Array as A
import Data.Either as E
import Data.Filterable as F
import Data.List as L
import Data.NonEmpty as NE
import Data.Function (id)
import Data.Functor (class Functor, map)
import Data.Maybe (Maybe(..), isJust, fromJust)
import Data.Tuple (Tuple(..), snd)
import Partial.Unsafe (unsafePartialBecause)
import Prelude ((-), (+), ($), (<<<), (<=), otherwise)

data InfiniteList b a = IL (b -> a) (b -> b) b

-- Can't implement these classes
-- Eq: can't compare functions
-- Show: can't iterate the whole list...will let other people implement custom show methods
-- Ord: Requires Eq to be possible
-- Semigroup: Would be stupid ... since the lists are infinite xs <> ys => xs because you would never get to the elements of ys
-- Monoid: Infinite lists, by definition, cannot be empty. What would mempty be?
-- Foldable: You can't fold an infinite list
-- Traversable: You can't traverse the entirity of an infinite list
-- Alt: No, for the same reason as semigroup
-- Plus: Depends on Alt

instance infiniteFunctor :: Functor (InfiniteList a) where
  map f (IL conv iter start) = IL (f <<< conv) iter start

instance infiniteFilterable :: F.Filterable (InfiniteList a) where
  partitionMap = partitionMapInternal

  partition = partitionInternal

  filterMap = filterMapInternal

  filter = filterInternal

partitionMapInternal :: forall a b l r. (a -> E.Either l r) -> InfiniteList b a -> { left :: InfiniteList b l, right :: InfiniteList b r }
partitionMapInternal f il = {
    left: fromLeft applied,
    right: fromRight applied
  }
  where
    applied = map f il

fromLeft :: forall a b c. InfiniteList b (E.Either a c) -> InfiniteList b a
fromLeft = map (unsafePartialBecause "We have filtered on only the left elements" E.fromLeft) <<< filterInternal E.isLeft

fromRight :: forall a b c. InfiniteList b (E.Either c a) -> InfiniteList b a
fromRight = map (unsafePartialBecause "We have filtered on only the right elements" E.fromRight) <<< filterInternal E.isRight

partitionInternal :: forall a b. (a -> Boolean) -> InfiniteList b a -> { no :: InfiniteList b a, yes :: InfiniteList b a }
partitionInternal p xs = let o = partitionMapInternal (F.eitherBool p) xs
                         in {no: o.left, yes: o.right}

filterMapInternal :: forall a b c. (a -> Maybe c) -> InfiniteList b a -> InfiniteList b c
filterMapInternal f = catMaybes <<< map f

catMaybes :: forall b a. InfiniteList b (Maybe a) -> InfiniteList b a
catMaybes = map (unsafePartialBecause "We have filtered on only the Just elements" fromJust) <<< filterInternal isJust

filterInternal :: forall a b. (a -> Boolean) -> InfiniteList b a -> InfiniteList b a
filterInternal matches (IL conv iter start) = IL conv next nextStart
  where
    nextStart = if matches' start then start else next start

    next x = let step = iter x in
             if matches' step then step else next step

    matches' = matches <<< conv

-- We could possibly implement Apply if the need for it was there

iterate :: forall a. (a -> a) -> a -> InfiniteList a a
iterate iter start = IL id iter start

repeat :: forall a. NE.NonEmpty L.List a -> InfiniteList (Tuple Int a) a
repeat oxs = IL snd iter firstVal
  where
    ref = index 0 (L.toUnfoldable <<< NE.oneOf $ oxs)

    index :: Int -> Array a -> Array (Tuple Int a)
    index n values = case A.uncons values of
      Just {head: x, tail: xs} -> Tuple n x `A.cons` index (n + 1) xs
      Nothing -> []

    iter :: Tuple Int a -> Tuple Int a
    iter (Tuple cIndex _) = case A.index ref (cIndex + 1) of
      Just x -> x
      Nothing -> firstVal

    firstVal = Tuple 0 (NE.head oxs)

head :: forall a b. InfiniteList b a -> a
head (IL conv _ x) = conv x

tail :: forall a b. InfiniteList b a -> InfiniteList b a
tail (IL conv iter current) = IL conv iter (iter current)

uncons :: forall a b. InfiniteList b a -> { head :: a, tail :: InfiniteList b a }
uncons (IL conv iter start) = { head: conv start, tail: IL conv iter (iter start) }

take :: forall a b. Int -> InfiniteList b a -> L.List a
take n il | n <= 0    = L.Nil
          | otherwise = head il `L.Cons` take (n - 1) (tail il)

drop :: forall a b. Int -> InfiniteList b a -> InfiniteList b a
drop n il | n <= 0    = il
          | otherwise = drop (n - 1) (tail il)

takeWhile :: forall a b. (a -> Boolean) -> InfiniteList b a -> L.List a
takeWhile keep = go
  where
    go :: InfiniteList b a -> L.List a
    go il = let u = uncons il
            in if keep u.head then u.head `L.Cons` go u.tail else L.Nil

dropWhile :: forall a b. (a -> Boolean) -> InfiniteList b a -> InfiniteList b a
dropWhile discard = go
  where
    go :: InfiniteList b a -> InfiniteList b a
    go il = if discard (head il) then go (tail il) else il

zip :: forall a b c d. InfiniteList c a -> InfiniteList d b -> InfiniteList (Tuple c d) (Tuple a b)
zip (IL lConv lIter lStart) (IL rConv rIter rStart) = IL conv iter start
  where
    conv (Tuple x y) = Tuple (lConv x) (rConv y)
    iter (Tuple x y) = Tuple (lIter x) (rIter y)
    start = Tuple lStart rStart