Fix ShadowedName warning

Fix ShadowedName warning

module Data.String.Utils
  ( NormalizationForm(..)
  , charAt
  , codePointAt
  , codePointAt'
  , endsWith
  , endsWith'
  , escapeRegex
  , filter
  , fromCharArray
  , includes
  , includes'
  , length
  , lines
  , mapChars
  , normalize
  , normalize'
  , repeat
  , replaceAll
  , startsWith
  , startsWith'
  , stripChars
  , stripDiacritics
  , toCharArray
  , unsafeCodePointAt
  , unsafeCodePointAt'
  , unsafeRepeat
  , words
  )
where

import Data.Either             (fromRight)
import Data.Maybe              (Maybe(Just, Nothing))
import Data.String.Regex       (Regex, replace, regex)
import Data.String.Regex.Flags (global)
import Partial.Unsafe          (unsafePartial)
import Prelude

import Data.Array as Array

-- | Return the character at the given index, if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple wrapper around JavaScript's `String.prototype.charAt`
-- | method, you should use the `Data.String.charAt` function from
-- | `purescript-strings.`
-- | This function returns a `String` instead of a `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Data.String.Utils.charAt
-- | charAt 2 "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == Just "𝕣"
-- | -- Data.String.charAt
-- | charAt 2 "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == Just '�'
-- | ```
charAt :: Int -> String -> Maybe String
charAt n str = Array.index (toCharArray str) n

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple wrapper around JavaScript's
-- | `String.prototype.codePointAt` method, you should use `codePointAt'`.
-- |
-- | Example:
-- | ```purescript
-- | codePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120792
-- | codePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Nothing
-- |
-- | codePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57304   -- Surrogate code point
-- | codePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57313   -- Surrogate code point
-- | ```
codePointAt :: Int -> String -> Maybe Int
codePointAt = _codePointAt Just Nothing

foreign import _codePointAt
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | This function is a simple wrapper around JavaScript's
-- | `String.prototype.codePointAt` method. This means that if the index does
-- | not point to the beginning of a valid surrogate pair, the code unit at
-- | the index (i.e. the Unicode code point of the surrogate pair half) is
-- | returned instead.
-- | If you want to treat a string as an array of Unicode Code Points, use
-- | `codePointAt` instead.
-- |
-- | Example:
-- | ```purescript
-- | codePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57304   -- Surrogate code point
-- | codePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57313   -- Surrogate code point
-- |
-- | codePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120792
-- | codePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Nothing
-- | ```
codePointAt' :: Int -> String -> Maybe Int
codePointAt' = _codePointAtP Just Nothing

foreign import _codePointAtP
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Determine whether the second string ends with the first one.
foreign import endsWith :: String -> String -> Boolean

-- | Determine whether the second string ends with the first one
-- | but search as if the string were only as long as the given argument.
endsWith' :: String -> Int -> String -> Boolean
endsWith' = endsWithP

foreign import endsWithP :: String -> Int -> String -> Boolean

-- | Escape a string so that it can be used as a literal string within a regular
-- | expression.
foreign import escapeRegex :: String -> String

-- | Keep only those characters that satisfy the predicate.
-- | This function uses `String` instead of `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
filter :: (String -> Boolean) -> String -> String
filter p = fromCharArray <<< Array.filter p <<< toCharArray

-- | Convert an array of characters into a `String`.
-- | This function uses `String` instead of `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | fromCharArray ["ℙ", "∪", "𝕣", "ⅇ", "Ⴝ", "𝚌", "𝕣", "ⅈ", "𝚙", "†"]
-- |   == "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- | ```
foreign import fromCharArray :: Array String -> String

-- | Determine whether the second arguments contains the first one.
-- |
-- | Example:
-- | ```purescript
-- | includes "Merchant" "The Merchant of Venice" === true
-- | includes "Duncan"   "The Merchant of Venice" === false
-- | ```
foreign import includes :: String -> String -> Boolean

-- | Determine whether the second string argument contains the first one,
-- | beginning the search at the given position.
-- | Note that this function handles Unicode as you would expect.
-- | Negative `position` values result in a search from the beginning of the
-- | string.
-- |
-- | Example:
-- | ```purescript
-- | includes' "𝟙"  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == true
-- | includes' "𝟙"  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == false
-- | includes' "𝟡" 10 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == false
-- | -- This behaviour is different from `String.prototype.includes`:
-- | -- "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡".includes("𝟡", 10) == true
-- | ```
includes' :: String -> Int -> String -> Boolean
includes' = includesP

foreign import includesP :: String -> Int -> String -> Boolean

-- | Return the number of Unicode code points in a string.
-- | Note that this function correctly accounts for Unicode symbols that
-- | are made up of surrogate pairs. If you want a simple wrapper around
-- | JavaScript's `string.length` property, you should use the
-- | `Data.String.length` function from `purescript-strings`.
-- |
-- | ```purescript
-- | length "PureScript" == 10
-- | length "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == 10    -- 14 with `Data.String.length`
-- | ```
foreign import length :: String -> Int

-- | Split a string into an array of strings which were delimited by newline
-- | characters.
-- |
-- | Example:
-- | ```purescript
-- | lines "Action\nis\neloquence." == ["Action", "is", "eloquence."]
-- | ```
foreign import lines :: String -> Array String

-- | Return the string obtained by applying the mapping function to each
-- | character (i.e. Unicode code point) of the input string.
-- | Note that this is probably not what you want as Unicode code points are
-- | not necessarily the same as user-perceived characters (grapheme clusters).
-- | Only use this function if you know what you are doing.
-- | This function uses `String`s instead of `Char`s because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Mapping over what appears to be six characters...
-- | mapChars (const "x") "Åström" == "xxxxxxxx" -- See? Don't use this!
-- | ```
mapChars :: (String -> String) -> String -> String
mapChars f = fromCharArray <<< map f <<< toCharArray

-- | Return the `Normalization Form C` of a given string.
-- | This is the form that is recommended by the W3C.
foreign import normalize :: String -> String

-- | Possible Unicode Normalization Forms
data NormalizationForm = NFC | NFD | NFKC | NFKD

instance showNormalizationForm :: Show NormalizationForm where
  show NFC  = "NFC"
  show NFD  = "NFD"
  show NFKC = "NFKC"
  show NFKD = "NFKD"

-- | Return a given Unicode Normalization Form of a string.
normalize' :: NormalizationForm -> String -> String
normalize' = _normalizeP <<< show

foreign import _normalizeP :: String -> String -> String

-- | Return a string that contains the specified number of copies of the input
-- | string concatenated together. Return `Nothing` if the repeat count is
-- | negative or if the resulting string would overflow the maximum string size.
-- |
-- | Example:
-- | ```purescript
-- | repeat 3 "𝟞" == Just "𝟞𝟞𝟞"
-- | repeat (-1) "PureScript" == Nothing
-- | repeat 2147483647 "PureScript" == Nothing
-- | ```
repeat :: Int -> String -> Maybe String
repeat = _repeat Just Nothing

foreign import _repeat
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe String

-- | Replace all occurences of the first argument with the second argument.
replaceAll :: String -> String -> String -> String
replaceAll = replace <<< mkRegex
  where
    -- Helper function to construct a `Regex` from an input string
    mkRegex :: String -> Regex
    mkRegex str = unsafePartial (fromRight (regex (escapeRegex str) global))

-- | Determine whether the second argument starts with the first one.
foreign import startsWith :: String -> String -> Boolean

-- | Determine whether a string starts with a certain substring at a given
-- | position.
startsWith' :: String -> Int -> String -> Boolean
startsWith' = startsWithP

foreign import startsWithP :: String -> Int -> String -> Boolean

-- | Strip a set of characters from a string.
-- | This function is case-sensitive.
-- |
-- | Example:
-- | ```purescript
-- | stripChars "aeiou" "PureScript" == "PrScrpt"
-- | stripChars "AEIOU" "PureScript" == "PureScript"
-- | ```
foreign import stripChars :: String -> String -> String

-- | Strip diacritics from a string.
-- |
-- | Example:
-- | ```purescript
-- | stripDiacritics "Ångström"        == "Angstrom"
-- | stripDiacritics "Crème Brulée"    == "Creme Brulee"
-- | stripDiacritics "Götterdämmerung" == "Gotterdammerung"
-- | stripDiacritics "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"      == "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- | stripDiacritics "Raison d'être"   == "Raison d'etre"
-- | stripDiacritics "Týr"             == "Tyr"
-- | stripDiacritics "Zürich"          == "Zurich"
-- | ```
foreign import stripDiacritics :: String -> String

-- | Convert a string to an array of Unicode code points.
-- | Note that this function is different from
-- | `Data.String.toCharArray` in `purescript-strings` which
-- | converts a string to an array of 16-bit code units.
-- | The difference becomes apparent when converting strings
-- | that contain characters which are internally represented
-- | as surrogate pairs.
-- | This function uses `String`s instead of `Char`s because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Data.String.Utils
-- | toCharArray "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- |   == ["ℙ", "∪", "𝕣", "ⅇ", "Ⴝ", "𝚌", "𝕣", "ⅈ", "𝚙", "†"]
-- |
-- | -- Data.String
-- | toCharArray "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" ==
-- |   ['ℙ', '∪', '�', '�', 'ⅇ', 'Ⴝ', '�', '�', '�', '�', 'ⅈ', '�', '�', '†']
-- | ```
foreign import toCharArray :: String -> Array String

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple (unsafe) wrapper around JavaScript's
-- | `String.prototype.codePointAt` method, you should use `unsafeCodePointAt'`.
-- |
-- | **Unsafe:** Throws runtime exception if the index is not within bounds.
-- |
-- | Example:
-- | ```purescript
-- | unsafeCodePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120792
-- | unsafeCodePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" -- Error
-- |
-- | unsafeCodePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57304   -- Surrogate code point
-- | unsafeCodePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57313   -- Surrogate code point
-- | ```
foreign import unsafeCodePointAt :: Int -> String -> Int

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | This function is a simple (unsafe) wrapper around JavaScript's
-- | `String.prototype.codePointAt` method. This means that if the index does
-- | not point to the beginning of a valid surrogate pair, the code unit at
-- | the index (i.e. the Unicode code point of the surrogate pair half) is
-- | returned instead.
-- | If you want to treat a string as an array of Unicode Code Points, use
-- | `unsafeCodePointAt` instead.
-- |
-- | Example:
-- | ```purescript
-- | unsafeCodePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57304   -- Surrogate code point
-- | unsafeCodePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57313   -- Surrogate code point
-- |
-- | unsafeCodePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120792
-- | unsafeCodePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" -- Error
-- | ```
unsafeCodePointAt' :: Int -> String -> Int
unsafeCodePointAt' = unsafeCodePointAtP

foreign import unsafeCodePointAtP :: Int -> String -> Int

-- | Return a string that contains the specified number of copies of the input
-- | string concatenated together.
-- |
-- | **Unsafe:** Throws runtime exception if the repeat count is negative or if
-- | the resulting string would overflow the maximum string size.
foreign import unsafeRepeat :: Int -> String -> String

-- | Split a string into an array of strings which were delimited by white space
-- | characters.
-- |
-- | Example:
-- | ```purescript
-- | words "Action is eloquence." == ["Action", "is", "eloquence."]
-- | ```
foreign import words :: String -> Array String

module Data.String.Utils
  ( NormalizationForm(..)
  , charAt
  , codePointAt
  , codePointAt'
  , endsWith
  , endsWith'
  , escapeRegex
  , filter
  , fromCharArray
  , includes
  , includes'
  , length
  , lines
  , mapChars
  , normalize
  , normalize'
  , repeat
  , replaceAll
  , startsWith
  , startsWith'
  , stripChars
  , stripDiacritics
  , toCharArray
  , unsafeCodePointAt
  , unsafeCodePointAt'
  , unsafeRepeat
  , words
  )
where

import Data.Either             (fromRight)
import Data.Maybe              (Maybe(Just, Nothing))
import Data.String.Regex       (Regex, replace, regex)
import Data.String.Regex.Flags (global)
import Partial.Unsafe          (unsafePartial)
import Prelude

import Data.Array as Array

-- | Return the character at the given index, if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple wrapper around JavaScript's `String.prototype.charAt`
-- | method, you should use the `Data.String.charAt` function from
-- | `purescript-strings.`
-- | This function returns a `String` instead of a `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Data.String.Utils.charAt
-- | charAt 2 "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == Just "𝕣"
-- | -- Data.String.charAt
-- | charAt 2 "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == Just '�'
-- | ```
charAt :: Int -> String -> Maybe String
charAt n str = Array.index (toCharArray str) n

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple wrapper around JavaScript's
-- | `String.prototype.codePointAt` method, you should use `codePointAt'`.
-- |
-- | Example:
-- | ```purescript
-- | codePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120792
-- | codePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Nothing
-- |
-- | codePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57304   -- Surrogate code point
-- | codePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57313   -- Surrogate code point
-- | ```
codePointAt :: Int -> String -> Maybe Int
codePointAt = _codePointAt Just Nothing

foreign import _codePointAt
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | This function is a simple wrapper around JavaScript's
-- | `String.prototype.codePointAt` method. This means that if the index does
-- | not point to the beginning of a valid surrogate pair, the code unit at
-- | the index (i.e. the Unicode code point of the surrogate pair half) is
-- | returned instead.
-- | If you want to treat a string as an array of Unicode Code Points, use
-- | `codePointAt` instead.
-- |
-- | Example:
-- | ```purescript
-- | codePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57304   -- Surrogate code point
-- | codePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 57313   -- Surrogate code point
-- |
-- | codePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120792
-- | codePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120793
-- | codePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Just 120794
-- | codePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == Nothing
-- | ```
codePointAt' :: Int -> String -> Maybe Int
codePointAt' = _codePointAtP Just Nothing

foreign import _codePointAtP
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe Int

-- | Determine whether the second string ends with the first one.
foreign import endsWith :: String -> String -> Boolean

-- | Determine whether the second string ends with the first one
-- | but search as if the string were only as long as the given argument.
endsWith' :: String -> Int -> String -> Boolean
endsWith' = endsWithP

foreign import endsWithP :: String -> Int -> String -> Boolean

-- | Escape a string so that it can be used as a literal string within a regular
-- | expression.
foreign import escapeRegex :: String -> String

-- | Keep only those characters that satisfy the predicate.
-- | This function uses `String` instead of `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
filter :: (String -> Boolean) -> String -> String
filter p = fromCharArray <<< Array.filter p <<< toCharArray

-- | Convert an array of characters into a `String`.
-- | This function uses `String` instead of `Char` because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | fromCharArray ["ℙ", "∪", "𝕣", "ⅇ", "Ⴝ", "𝚌", "𝕣", "ⅈ", "𝚙", "†"]
-- |   == "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- | ```
foreign import fromCharArray :: Array String -> String

-- | Determine whether the second arguments contains the first one.
-- |
-- | Example:
-- | ```purescript
-- | includes "Merchant" "The Merchant of Venice" === true
-- | includes "Duncan"   "The Merchant of Venice" === false
-- | ```
foreign import includes :: String -> String -> Boolean

-- | Determine whether the second string argument contains the first one,
-- | beginning the search at the given position.
-- | Note that this function handles Unicode as you would expect.
-- | Negative `position` values result in a search from the beginning of the
-- | string.
-- |
-- | Example:
-- | ```purescript
-- | includes' "𝟙"  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == true
-- | includes' "𝟙"  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == false
-- | includes' "𝟡" 10 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == false
-- | -- This behaviour is different from `String.prototype.includes`:
-- | -- "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡".includes("𝟡", 10) == true
-- | ```
includes' :: String -> Int -> String -> Boolean
includes' = includesP

foreign import includesP :: String -> Int -> String -> Boolean

-- | Return the number of Unicode code points in a string.
-- | Note that this function correctly accounts for Unicode symbols that
-- | are made up of surrogate pairs. If you want a simple wrapper around
-- | JavaScript's `string.length` property, you should use the
-- | `Data.String.length` function from `purescript-strings`.
-- |
-- | ```purescript
-- | length "PureScript" == 10
-- | length "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" == 10    -- 14 with `Data.String.length`
-- | ```
foreign import length :: String -> Int

-- | Split a string into an array of strings which were delimited by newline
-- | characters.
-- |
-- | Example:
-- | ```purescript
-- | lines "Action\nis\neloquence." == ["Action", "is", "eloquence."]
-- | ```
foreign import lines :: String -> Array String

-- | Return the string obtained by applying the mapping function to each
-- | character (i.e. Unicode code point) of the input string.
-- | Note that this is probably not what you want as Unicode code points are
-- | not necessarily the same as user-perceived characters (grapheme clusters).
-- | Only use this function if you know what you are doing.
-- | This function uses `String`s instead of `Char`s because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Mapping over what appears to be six characters...
-- | mapChars (const "x") "Åström" == "xxxxxxxx" -- See? Don't use this!
-- | ```
mapChars :: (String -> String) -> String -> String
mapChars f = fromCharArray <<< map f <<< toCharArray

-- | Return the `Normalization Form C` of a given string.
-- | This is the form that is recommended by the W3C.
foreign import normalize :: String -> String

-- | Possible Unicode Normalization Forms
data NormalizationForm = NFC | NFD | NFKC | NFKD

instance showNormalizationForm :: Show NormalizationForm where
  show NFC  = "NFC"
  show NFD  = "NFD"
  show NFKC = "NFKC"
  show NFKD = "NFKD"

-- | Return a given Unicode Normalization Form of a string.
normalize' :: NormalizationForm -> String -> String
normalize' = _normalizeP <<< show

foreign import _normalizeP :: String -> String -> String

-- | Return a string that contains the specified number of copies of the input
-- | string concatenated together. Return `Nothing` if the repeat count is
-- | negative or if the resulting string would overflow the maximum string size.
-- |
-- | Example:
-- | ```purescript
-- | repeat 3 "𝟞" == Just "𝟞𝟞𝟞"
-- | repeat (-1) "PureScript" == Nothing
-- | repeat 2147483647 "PureScript" == Nothing
-- | ```
repeat :: Int -> String -> Maybe String
repeat = _repeat Just Nothing

foreign import _repeat
  :: (∀ a. a -> Maybe a)
  -> (∀ a. Maybe a)
  -> Int
  -> String
  -> Maybe String

-- | Replace all occurences of the first argument with the second argument.
replaceAll :: String -> String -> String -> String
replaceAll old new str = replace (mkRegex old) new str
  where
    -- Helper function to construct a `Regex` from an input string
    mkRegex :: String -> Regex
    mkRegex str = unsafePartial (fromRight (regex (escapeRegex str) global))

-- | Determine whether the second argument starts with the first one.
foreign import startsWith :: String -> String -> Boolean

-- | Determine whether a string starts with a certain substring at a given
-- | position.
startsWith' :: String -> Int -> String -> Boolean
startsWith' = startsWithP

foreign import startsWithP :: String -> Int -> String -> Boolean

-- | Strip a set of characters from a string.
-- | This function is case-sensitive.
-- |
-- | Example:
-- | ```purescript
-- | stripChars "aeiou" "PureScript" == "PrScrpt"
-- | stripChars "AEIOU" "PureScript" == "PureScript"
-- | ```
foreign import stripChars :: String -> String -> String

-- | Strip diacritics from a string.
-- |
-- | Example:
-- | ```purescript
-- | stripDiacritics "Ångström"        == "Angstrom"
-- | stripDiacritics "Crème Brulée"    == "Creme Brulee"
-- | stripDiacritics "Götterdämmerung" == "Gotterdammerung"
-- | stripDiacritics "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"      == "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- | stripDiacritics "Raison d'être"   == "Raison d'etre"
-- | stripDiacritics "Týr"             == "Tyr"
-- | stripDiacritics "Zürich"          == "Zurich"
-- | ```
foreign import stripDiacritics :: String -> String

-- | Convert a string to an array of Unicode code points.
-- | Note that this function is different from
-- | `Data.String.toCharArray` in `purescript-strings` which
-- | converts a string to an array of 16-bit code units.
-- | The difference becomes apparent when converting strings
-- | that contain characters which are internally represented
-- | as surrogate pairs.
-- | This function uses `String`s instead of `Char`s because PureScript
-- | `Char`s must be UTF-16 code units and hence cannot represent all Unicode
-- | code points.
-- |
-- | Example:
-- | ```purescript
-- | -- Data.String.Utils
-- | toCharArray "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†"
-- |   == ["ℙ", "∪", "𝕣", "ⅇ", "Ⴝ", "𝚌", "𝕣", "ⅈ", "𝚙", "†"]
-- |
-- | -- Data.String
-- | toCharArray "ℙ∪𝕣ⅇႽ𝚌𝕣ⅈ𝚙†" ==
-- |   ['ℙ', '∪', '�', '�', 'ⅇ', 'Ⴝ', '�', '�', '�', '�', 'ⅈ', '�', '�', '†']
-- | ```
foreign import toCharArray :: String -> Array String

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | Note that this function handles Unicode as you would expect.
-- | If you want a simple (unsafe) wrapper around JavaScript's
-- | `String.prototype.codePointAt` method, you should use `unsafeCodePointAt'`.
-- |
-- | **Unsafe:** Throws runtime exception if the index is not within bounds.
-- |
-- | Example:
-- | ```purescript
-- | unsafeCodePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120792
-- | unsafeCodePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" -- Error
-- |
-- | unsafeCodePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57304   -- Surrogate code point
-- | unsafeCodePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57313   -- Surrogate code point
-- | ```
foreign import unsafeCodePointAt :: Int -> String -> Int

-- | Return the Unicode code point value of the character at the given index,
-- | if the index is within bounds.
-- | This function is a simple (unsafe) wrapper around JavaScript's
-- | `String.prototype.codePointAt` method. This means that if the index does
-- | not point to the beginning of a valid surrogate pair, the code unit at
-- | the index (i.e. the Unicode code point of the surrogate pair half) is
-- | returned instead.
-- | If you want to treat a string as an array of Unicode Code Points, use
-- | `unsafeCodePointAt` instead.
-- |
-- | Example:
-- | ```purescript
-- | unsafeCodePointAt'  0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt'  1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57304   -- Surrogate code point
-- | unsafeCodePointAt'  2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt' 19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 57313   -- Surrogate code point
-- |
-- | unsafeCodePointAt   0 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120792
-- | unsafeCodePointAt   1 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120793
-- | unsafeCodePointAt   2 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" == 120794
-- | unsafeCodePointAt  19 "𝟘𝟙𝟚𝟛𝟜𝟝𝟞𝟟𝟠𝟡" -- Error
-- | ```
unsafeCodePointAt' :: Int -> String -> Int
unsafeCodePointAt' = unsafeCodePointAtP

foreign import unsafeCodePointAtP :: Int -> String -> Int

-- | Return a string that contains the specified number of copies of the input
-- | string concatenated together.
-- |
-- | **Unsafe:** Throws runtime exception if the repeat count is negative or if
-- | the resulting string would overflow the maximum string size.
foreign import unsafeRepeat :: Int -> String -> String

-- | Split a string into an array of strings which were delimited by white space
-- | characters.
-- |
-- | Example:
-- | ```purescript
-- | words "Action is eloquence." == ["Action", "is", "eloquence."]
-- | ```
foreign import words :: String -> Array String


Add somewhat friendly developer error message

module Language.Docopt.Errors where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.List (List(..), reverse, toList)
import Data.Function (on)
import Data.Foldable (intercalate)
import Data.Monoid (Monoid)
import Data.String (fromChar, fromCharArray)
import Data.String.Ext (startsWith)
import Control.Apply ((*>))
import Data.Generic
import Data.Array as A
import Text.Wrap (dedent)
import qualified Data.String as Str

import Language.Docopt.Value
import Language.Docopt.Argument
import qualified Language.Docopt.Option as O

--------------------------------------------------------------------------------
-- XXX: Temporary polyfill until new version of `Data.List` is released.
--------------------------------------------------------------------------------

mapWithIndex :: forall a b. (a -> Int -> b) -> List a -> List b
mapWithIndex f lst = reverse $ go 0 lst Nil
  where
  go _ Nil acc = acc
  go n (Cons x xs) acc = go (n+1) xs $ Cons (f x n) acc

--------------------------------------------------------------------------------
-- Errors (XXX: needs migration and improvement) -------------------------------
--------------------------------------------------------------------------------

import qualified Text.Parsing.Parser     as P
import qualified Text.Parsing.Parser.Pos as P

type Argv = Array String
newtype SolveError = SolveError String

data DocoptError
  = DocoptScanError       P.ParseError
  | DocoptUsageParseError P.ParseError
  | DocoptDescParseError  P.ParseError
  | DocoptUserParseError  Argv P.ParseError
  | DocoptSolveError      SolveError

derive instance genericSolveError :: Generic SolveError

instance showSolveError :: Show SolveError where
  show = gShow

instance showDocoptError :: Show DocoptError where
  show (DocoptScanError        e) = "DocoptScanError "  ++ show e
  show (DocoptUsageParseError  e) = "DocoptParseError " ++ show e
  show (DocoptDescParseError   e) = "DocoptParseError " ++ show e
  show (DocoptUserParseError _ e) = "DocoptParseError " ++ show e
  show (DocoptSolveError       e) = "DocoptSolveError"  ++ show e

unParseError :: forall r. P.ParseError -> { message :: String
                                          , position :: P.Position }
unParseError (P.ParseError e) = e

developerErrorMessage :: String
developerErrorMessage = dedent """
  This is likely an error with the program itself and not your fault.
  Please raise this with the program's author.
"""

prettyPrintDocoptError :: DocoptError -> String
prettyPrintDocoptError (DocoptScanError err) =
  "Failed to disect docopt text. " ++ (unParseError err).message
  ++ "\n"
  ++ developerErrorMessage
prettyPrintDocoptError (DocoptUsageParseError err) =
  "Failed to parse the formal usage specification. "
  ++ (unParseError err).message
  ++ "\n"
  ++ developerErrorMessage
prettyPrintDocoptError (DocoptDescParseError err) =
  "Failed to parse the option descriptions. "
  ++ (unParseError err).message
  ++ "\n"
  ++ developerErrorMessage
prettyPrintDocoptError (DocoptSolveError err) =
  "Incoherent specification. " ++ show err
  ++ "\n"
  ++ developerErrorMessage
prettyPrintDocoptError
  (DocoptUserParseError
    argv
    (P.ParseError { message: message
                  , position: P.Position { column: col } }))
  = let isTrailingError = startsWith "Trailing" message -- XXX: This is brittle
        squiggles =
          intercalate " " $ toList argv `flip mapWithIndex` \a i ->
                              fromCharArray $ A.replicate (Str.length a) $
                                if (if isTrailingError
                                        then (i + 1) >= col
                                        else (i + 1) == col
                                    ) then '^' else  ' '
        text = intercalate " " argv
     in if A.length argv > 0
           then message ++ ":\n$ " ++ text ++ "\n  " ++ squiggles
           else message

module Language.Docopt.Errors where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.List (List(..), reverse, toList)
import Data.Function (on)
import Data.Foldable (intercalate)
import Data.Monoid (Monoid)
import Data.String (fromChar, fromCharArray)
import Data.String.Ext (startsWith)
import Control.Apply ((*>))
import Data.Generic
import Data.Array as A
import qualified Data.String as Str

import Language.Docopt.Value
import Language.Docopt.Argument
import qualified Language.Docopt.Option as O

--------------------------------------------------------------------------------
-- XXX: Temporary polyfill until new version of `Data.List` is released.
--------------------------------------------------------------------------------

mapWithIndex :: forall a b. (a -> Int -> b) -> List a -> List b
mapWithIndex f lst = reverse $ go 0 lst Nil
  where
  go _ Nil acc = acc
  go n (Cons x xs) acc = go (n+1) xs $ Cons (f x n) acc

--------------------------------------------------------------------------------
-- Errors (XXX: needs migration and improvement) -------------------------------
--------------------------------------------------------------------------------

import qualified Text.Parsing.Parser     as P
import qualified Text.Parsing.Parser.Pos as P

type Argv = Array String
newtype SolveError = SolveError String

data DocoptError
  = DocoptScanError       P.ParseError
  | DocoptUsageParseError P.ParseError
  | DocoptDescParseError  P.ParseError
  | DocoptUserParseError  Argv P.ParseError
  | DocoptSolveError      SolveError

derive instance genericSolveError :: Generic SolveError

instance showSolveError :: Show SolveError where
  show = gShow

instance showDocoptError :: Show DocoptError where
  show (DocoptScanError        e) = "DocoptScanError "  ++ show e
  show (DocoptUsageParseError  e) = "DocoptParseError " ++ show e
  show (DocoptDescParseError   e) = "DocoptParseError " ++ show e
  show (DocoptUserParseError _ e) = "DocoptParseError " ++ show e
  show (DocoptSolveError       e) = "DocoptSolveError"  ++ show e

unParseError :: forall r. P.ParseError -> { message :: String
                                          , position :: P.Position }
unParseError (P.ParseError e) = e

prettyPrintDocoptError :: DocoptError -> String
prettyPrintDocoptError (DocoptScanError err) =
  "Failed to disect docopt text. " ++ (unParseError err).message
prettyPrintDocoptError (DocoptUsageParseError err) =
  "Failed to parse the formal usage specification. "
  ++ (unParseError err).message
prettyPrintDocoptError (DocoptDescParseError err) =
  "Failed to parse the option descriptions. "
  ++ (unParseError err).message
prettyPrintDocoptError (DocoptSolveError err) =
  "Incoherent specification. " ++ show err
prettyPrintDocoptError
  (DocoptUserParseError
    argv
    (P.ParseError { message: message
                  , position: P.Position { column: col } }))
  = let isTrailingError = startsWith "Trailing" message -- XXX: This is brittle
        squiggles =
          intercalate " " $ toList argv `flip mapWithIndex` \a i ->
                              fromCharArray $ A.replicate (Str.length a) $
                                if (if isTrailingError
                                        then (i + 1) >= col
                                        else (i + 1) == col
                                    ) then '^' else  ' '
        text = intercalate " " argv
     in if A.length argv > 0
           then message ++ ":\n$ " ++ text ++ "\n  " ++ squiggles
           else message


Add binding-matching and argument-replacing

module Evaluator where

import Data.StrMap
import Data.Tuple
import Data.Maybe
import Data.Foldable (foldl)

import Control.Apply ((*>))
import Control.Monad.State
import Control.Monad.State.Trans
import Control.Monad.State.Class
import Control.Monad.Trans

import AST

type Env = StrMap [Tuple [Binding] Expr]

defsToEnv :: [Definition] -> Env
defsToEnv = foldl insertDef empty

insertDef :: Env -> Definition -> Env
insertDef env (Def name bindings body) = case lookup name env of
  Nothing   -> insert name [Tuple bindings body] env
  Just defs -> insert name (defs ++ [Tuple bindings body]) env

eval1 :: Env -> Expr -> Expr
eval1 _ _ = Atom $ Name $ "not_implemented"

apply :: Env -> String -> [Expr] -> Maybe Expr
apply _ _ _ = Nothing

matchls :: [Binding] -> [Expr] -> Expr -> Maybe Expr
matchls []     []     expr = Just expr
matchls (b:bs) (e:es) expr = do
  expr' <- execStateT (match b e) expr
  matchls bs es expr'
matchls _ _ _ = Nothing

match :: Binding -> Expr -> StateT Expr Maybe Unit
match (Lit (Name x))   e                = modify (replace x e)
match (Lit (Num i))    (Atom (Num j))   | i == j  = return unit
match (Lit (Bool b))   (Atom (Bool b')) | b == b' = return unit
match (ConsLit b bs)   (List (e:es))    = match b e *> match bs (List es)
match (ListLit [])     (List [])        = return unit
match (ListLit (b:bs)) (List (e:es))    = match b e *> match (ListLit bs) (List es)
match _                _                = lift Nothing

replace :: String -> Expr -> Expr -> Expr
replace name value = go
  where
  go expr = case expr of
    a@(Atom (Name str)) -> if str == name then value else a
    (List exprs)        -> List (go <$> exprs)
    (Binary op e1 e2)   -> Binary op (go e1) (go e2)
    (Unary op e)        -> Unary op (go e)
    (SectL e op)        -> SectL (go e) op
    (SectR op e)        -> SectR op (go e)
    (App appName exprs) -> App appName (go <$> exprs)
    e                   -> e

module Evaluator where

import Data.StrMap
import Data.Tuple
import Data.Maybe

import AST

type Env = StrMap (Tuple [Binding] Expr)

defsToEnv :: [Definition] -> Env
defsToEnv _ = empty

eval1 :: Env -> Expr -> Expr
eval1 _ _ = Atom $ Name $ "not_implemented"

apply :: Env -> String -> [Expr] -> Maybe Expr
apply _ _ _ = Nothing

matchAndReplace :: [Binding] -> [Expr] -> Expr -> Maybe Expr
matchAndReplace _ _ _ = Nothing

replace :: String -> Expr -> Expr -> Expr
replace _ _ _ = Atom $ Name $ "not_implemented"


Actually query SparkLocal component (#1581)

{-
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.FileSystem.Dialog.Mount.Component
  ( component
  , module SlamData.FileSystem.Dialog.Mount.Component.Query
  , module MCS
  ) where

import SlamData.Prelude

import Data.Argonaut (jsonParser, decodeJson, (.?))
import Data.Lens (set, (.~), (?~))

import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Themes.Bootstrap3 as B

import SlamData.Dialog.Render (modalDialog, modalHeader, modalBody, modalFooter)
import SlamData.FileSystem.Dialog.Component.Message (Message(..))
import SlamData.FileSystem.Dialog.Mount.Common.SettingsQuery as SQ
import SlamData.FileSystem.Dialog.Mount.Component.ChildSlot as CS
import SlamData.FileSystem.Dialog.Mount.Component.Query (Query(..))
import SlamData.FileSystem.Dialog.Mount.Component.State as MCS
import SlamData.FileSystem.Dialog.Mount.Couchbase.Component as Couchbase
import SlamData.FileSystem.Dialog.Mount.MarkLogic.Component as MarkLogic
import SlamData.FileSystem.Dialog.Mount.MongoDB.Component as MongoDB
import SlamData.FileSystem.Dialog.Mount.SQL2.Component as SQL2
import SlamData.FileSystem.Dialog.Mount.Scheme as MS
import SlamData.FileSystem.Dialog.Mount.SparkHDFS.Component as Spark
import SlamData.FileSystem.Dialog.Mount.SparkLocal.Component as SparkLocal
import SlamData.GlobalError as GE
import SlamData.Monad (Slam)
import SlamData.Quasar.FS as Api
import SlamData.Render.CSS as RC

import Utils.DOM as DOM

type DSL = H.ParentDSL MCS.State Query CS.ChildQuery CS.ChildSlot Message Slam
type HTML = H.ParentHTML Query CS.ChildQuery CS.ChildSlot Slam

component ∷ H.Component HH.HTML Query MCS.Input Message Slam
component =
  H.parentComponent
    { initialState: MCS.initialState
    , render
    , eval
    , receiver: const Nothing
    }

render ∷ MCS.State → HTML
render state@{ new } =
  modalDialog
    [ modalHeader "Mount"
    , modalBody $
        HH.form
          [ HE.onSubmit $ HE.input PreventDefault
          , HP.class_ RC.dialogMount
          ]
          $ (guard new $> fldName state)
          <> (guard new $> selScheme state)
          <> maybe [] (pure ∘ settings) state.settings
          <> maybe [] (pure ∘ errorMessage) state.message
    , modalFooter
        [ progressSpinner state
        , btnCancel
        , btnMount state
        ]
    ]
  where
  settings ∷ MCS.MountSettings → HTML
  settings ss = case ss of
    MCS.MongoDB initialState →
      HH.slot' CS.cpMongoDB unit (MongoDB.comp initialState) unit (HE.input_ Validate)
    MCS.SQL2 initialState →
      HH.slot' CS.cpSQL unit (SQL2.comp initialState) unit (HE.input_ Validate)
    MCS.Couchbase initialState →
      HH.slot' CS.cpCouchbase unit (Couchbase.comp initialState) unit (HE.input_ Validate)
    MCS.MarkLogic initialState →
      HH.slot' CS.cpMarkLogic unit (MarkLogic.comp initialState) unit (HE.input_ Validate)
    MCS.SparkHDFS initialState →
      HH.slot' CS.cpSpark unit (Spark.comp initialState) unit (HE.input_ Validate)
    MCS.SparkLocal initialState ->
      HH.slot' CS.cpSparkLocal unit (SparkLocal.comp initialState) unit (HE.input_ Validate)

fldName ∷ MCS.State → HTML
fldName state =
  HH.div
    [ HP.classes [B.formGroup, RC.mountName] ]
    [ HH.label_
        [ HH.span_ [ HH.text "Name" ]
        , HH.input
            [ HP.class_ B.formControl
            , HE.onValueInput $ HE.input (ModifyState ∘ set MCS._name)
            , HP.value (state.name)
            ]
        ]
    ]

selScheme ∷ MCS.State → HTML
selScheme state =
  HH.div
    [ HP.class_ B.formGroup ]
    [ HH.label_
        [ HH.span_ [ HH.text "Mount type" ]
        , HH.select
            [ HP.class_ B.formControl
            , HE.onValueChange (HE.input SelectScheme ∘ MS.schemeFromString)
            ]
            $ [ HH.option_ [] ] <> schemeOptions
        ]
    ]
  where
  schemeOptions = map (\s → HH.option_ [ HH.text (MS.schemeToString s) ]) MS.schemes

errorMessage ∷ String → HTML
errorMessage msg =
  HH.div
    [ HP.classes [ B.alert, B.alertDanger ] ]
    [ HH.text msg ]

btnCancel ∷ HTML
btnCancel =
  HH.button
    [ HP.classes [B.btn]
    , HE.onClick (HE.input_ RaiseDismiss)
    ]
    [ HH.text "Cancel" ]

btnMount ∷ MCS.State → HTML
btnMount state@{ new, saving } =
  HH.button
    [ HP.classes [B.btn, B.btnPrimary]
    , HP.enabled (not saving && MCS.canSave state)
    , HE.onClick (HE.input_ NotifySave)
    ]
    [ HH.text text ]
  where
  text = if new then "Mount" else "Save changes"

progressSpinner ∷ MCS.State → HTML
progressSpinner { saving } =
  HH.img [ HP.src "img/spin.gif", HP.class_ (RC.mountProgressSpinner saving) ]

eval ∷ Query ~> DSL
eval (ModifyState f next) = H.modify f *> validateInput $> next
eval (SelectScheme newScheme next) = do
  currentScheme ← map MCS.scheme <$> H.gets _.settings
  when (currentScheme /= newScheme) do
    H.modify (MCS._settings .~ map MCS.initialSettings newScheme)
    validateInput
  pure next
eval (RaiseDismiss next) = do
  H.raise Dismiss
  pure next
eval (NotifySave next) = do
  H.raise MountSave
  pure next
eval (Save k) = do
  { parent, name, new } ← H.get
  H.modify (MCS._saving .~ true)
  newName ←
    if new then Api.getNewName parent name else pure (pure name)
  case newName of
    Left err → do
      handleQError err
      pure $ k Nothing
    Right newName' → do
      result ← querySettings (H.request (SQ.Submit parent newName'))
      mount ← case result of
        Just (Right m) → pure (Just m)
        Just (Left err) → do
          handleQError err
          pure Nothing
        Nothing → pure Nothing
      H.modify (MCS._saving .~ false)
      pure $ k mount
eval (PreventDefault ev next) = H.liftEff (DOM.preventDefault ev) $> next
eval (Validate next) = validateInput $> next

handleQError ∷ Api.QError → DSL Unit
handleQError err =
  case GE.fromQError err of
    Left msg → H.modify (MCS._message ?~ formatError msg)
    Right ge → GE.raiseGlobalError ge

validateInput ∷ DSL Unit
validateInput = do
  state ← H.get
  message ← runExceptT do
    liftMaybe (MCS.validate state)
    liftMaybe ∘ join =<< lift (querySettings (H.request SQ.Validate))
  H.modify (MCS._message .~ either Just (const Nothing) message)
  where
  liftMaybe ∷ Maybe String → ExceptT String DSL Unit
  liftMaybe = maybe (pure unit) throwError

formatError ∷ String → String
formatError err =
  "There was a problem saving the mount: " <> extract err
  where
  extract msg =
    either (const msg) id (jsonParser msg >>= decodeJson >>= (_ .? "error"))

querySettings ∷ forall a. (forall s. SQ.SettingsQuery s a) → DSL (Maybe a)
querySettings q = (map MCS.scheme <$> H.gets _.settings) >>= \s →
  case s of
    Just MS.MongoDB → H.query' CS.cpMongoDB unit q
    Just MS.SQL2 → H.query' CS.cpSQL unit q
    Just MS.Couchbase → H.query' CS.cpCouchbase unit q
    Just MS.MarkLogic → H.query' CS.cpMarkLogic unit q
    Just MS.SparkHDFS → H.query' CS.cpSpark unit q
    Just MS.SparkLocal → H.query' CS.cpSparkLocal unit q
    Nothing → pure Nothing

{-
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.FileSystem.Dialog.Mount.Component
  ( component
  , module SlamData.FileSystem.Dialog.Mount.Component.Query
  , module MCS
  ) where

import SlamData.Prelude

import Data.Argonaut (jsonParser, decodeJson, (.?))
import Data.Lens (set, (.~), (?~))

import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Themes.Bootstrap3 as B

import SlamData.Dialog.Render (modalDialog, modalHeader, modalBody, modalFooter)
import SlamData.FileSystem.Dialog.Component.Message (Message(..))
import SlamData.FileSystem.Dialog.Mount.Common.SettingsQuery as SQ
import SlamData.FileSystem.Dialog.Mount.Component.ChildSlot as CS
import SlamData.FileSystem.Dialog.Mount.Component.Query (Query(..))
import SlamData.FileSystem.Dialog.Mount.Component.State as MCS
import SlamData.FileSystem.Dialog.Mount.Couchbase.Component as Couchbase
import SlamData.FileSystem.Dialog.Mount.MarkLogic.Component as MarkLogic
import SlamData.FileSystem.Dialog.Mount.MongoDB.Component as MongoDB
import SlamData.FileSystem.Dialog.Mount.SQL2.Component as SQL2
import SlamData.FileSystem.Dialog.Mount.Scheme as MS
import SlamData.FileSystem.Dialog.Mount.SparkHDFS.Component as Spark
import SlamData.FileSystem.Dialog.Mount.SparkLocal.Component as SparkLocal
import SlamData.GlobalError as GE
import SlamData.Monad (Slam)
import SlamData.Quasar.FS as Api
import SlamData.Render.CSS as RC

import Utils.DOM as DOM

type DSL = H.ParentDSL MCS.State Query CS.ChildQuery CS.ChildSlot Message Slam
type HTML = H.ParentHTML Query CS.ChildQuery CS.ChildSlot Slam

component ∷ H.Component HH.HTML Query MCS.Input Message Slam
component =
  H.parentComponent
    { initialState: MCS.initialState
    , render
    , eval
    , receiver: const Nothing
    }

render ∷ MCS.State → HTML
render state@{ new } =
  modalDialog
    [ modalHeader "Mount"
    , modalBody $
        HH.form
          [ HE.onSubmit $ HE.input PreventDefault
          , HP.class_ RC.dialogMount
          ]
          $ (guard new $> fldName state)
          <> (guard new $> selScheme state)
          <> maybe [] (pure ∘ settings) state.settings
          <> maybe [] (pure ∘ errorMessage) state.message
    , modalFooter
        [ progressSpinner state
        , btnCancel
        , btnMount state
        ]
    ]
  where
  settings ∷ MCS.MountSettings → HTML
  settings ss = case ss of
    MCS.MongoDB initialState →
      HH.slot' CS.cpMongoDB unit (MongoDB.comp initialState) unit (HE.input_ Validate)
    MCS.SQL2 initialState →
      HH.slot' CS.cpSQL unit (SQL2.comp initialState) unit (HE.input_ Validate)
    MCS.Couchbase initialState →
      HH.slot' CS.cpCouchbase unit (Couchbase.comp initialState) unit (HE.input_ Validate)
    MCS.MarkLogic initialState →
      HH.slot' CS.cpMarkLogic unit (MarkLogic.comp initialState) unit (HE.input_ Validate)
    MCS.SparkHDFS initialState →
      HH.slot' CS.cpSpark unit (Spark.comp initialState) unit (HE.input_ Validate)
    MCS.SparkLocal initialState ->
      HH.slot' CS.cpSparkLocal unit (SparkLocal.comp initialState) unit (HE.input_ Validate)

fldName ∷ MCS.State → HTML
fldName state =
  HH.div
    [ HP.classes [B.formGroup, RC.mountName] ]
    [ HH.label_
        [ HH.span_ [ HH.text "Name" ]
        , HH.input
            [ HP.class_ B.formControl
            , HE.onValueInput $ HE.input (ModifyState ∘ set MCS._name)
            , HP.value (state.name)
            ]
        ]
    ]

selScheme ∷ MCS.State → HTML
selScheme state =
  HH.div
    [ HP.class_ B.formGroup ]
    [ HH.label_
        [ HH.span_ [ HH.text "Mount type" ]
        , HH.select
            [ HP.class_ B.formControl
            , HE.onValueChange (HE.input SelectScheme ∘ MS.schemeFromString)
            ]
            $ [ HH.option_ [] ] <> schemeOptions
        ]
    ]
  where
  schemeOptions = map (\s → HH.option_ [ HH.text (MS.schemeToString s) ]) MS.schemes

errorMessage ∷ String → HTML
errorMessage msg =
  HH.div
    [ HP.classes [ B.alert, B.alertDanger ] ]
    [ HH.text msg ]

btnCancel ∷ HTML
btnCancel =
  HH.button
    [ HP.classes [B.btn]
    , HE.onClick (HE.input_ RaiseDismiss)
    ]
    [ HH.text "Cancel" ]

btnMount ∷ MCS.State → HTML
btnMount state@{ new, saving } =
  HH.button
    [ HP.classes [B.btn, B.btnPrimary]
    , HP.enabled (not saving && MCS.canSave state)
    , HE.onClick (HE.input_ NotifySave)
    ]
    [ HH.text text ]
  where
  text = if new then "Mount" else "Save changes"

progressSpinner ∷ MCS.State → HTML
progressSpinner { saving } =
  HH.img [ HP.src "img/spin.gif", HP.class_ (RC.mountProgressSpinner saving) ]

eval ∷ Query ~> DSL
eval (ModifyState f next) = H.modify f *> validateInput $> next
eval (SelectScheme newScheme next) = do
  currentScheme ← map MCS.scheme <$> H.gets _.settings
  when (currentScheme /= newScheme) do
    H.modify (MCS._settings .~ map MCS.initialSettings newScheme)
    validateInput
  pure next
eval (RaiseDismiss next) = do
  H.raise Dismiss
  pure next
eval (NotifySave next) = do
  H.raise MountSave
  pure next
eval (Save k) = do
  { parent, name, new } ← H.get
  H.modify (MCS._saving .~ true)
  newName ←
    if new then Api.getNewName parent name else pure (pure name)
  case newName of
    Left err → do
      handleQError err
      pure $ k Nothing
    Right newName' → do
      result ← querySettings (H.request (SQ.Submit parent newName'))
      mount ← case result of
        Just (Right m) → pure (Just m)
        Just (Left err) → do
          handleQError err
          pure Nothing
        Nothing → pure Nothing
      H.modify (MCS._saving .~ false)
      pure $ k mount
eval (PreventDefault ev next) = H.liftEff (DOM.preventDefault ev) $> next
eval (Validate next) = validateInput $> next

handleQError ∷ Api.QError → DSL Unit
handleQError err =
  case GE.fromQError err of
    Left msg → H.modify (MCS._message ?~ formatError msg)
    Right ge → GE.raiseGlobalError ge

validateInput ∷ DSL Unit
validateInput = do
  state ← H.get
  message ← runExceptT do
    liftMaybe (MCS.validate state)
    liftMaybe ∘ join =<< lift (querySettings (H.request SQ.Validate))
  H.modify (MCS._message .~ either Just (const Nothing) message)
  where
  liftMaybe ∷ Maybe String → ExceptT String DSL Unit
  liftMaybe = maybe (pure unit) throwError

formatError ∷ String → String
formatError err =
  "There was a problem saving the mount: " <> extract err
  where
  extract msg =
    either (const msg) id (jsonParser msg >>= decodeJson >>= (_ .? "error"))

querySettings ∷ forall a. (forall s. SQ.SettingsQuery s a) → DSL (Maybe a)
querySettings q = (map MCS.scheme <$> H.gets _.settings) >>= \s →
  case s of
    Just MS.MongoDB → H.query' CS.cpMongoDB unit q
    Just MS.SQL2 → H.query' CS.cpSQL unit q
    Just MS.Couchbase → H.query' CS.cpCouchbase unit q
    Just MS.MarkLogic → H.query' CS.cpMarkLogic unit q
    Just MS.SparkHDFS → H.query' CS.cpSpark unit q
    _ → pure Nothing


Use generic parsePath that previously wouldn't typecheck

{-
Copyright 2015 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 Model.Resource
  ( Resource(..)
  , _filePath
  , _name
  , _nameAnyPath
  , _path
  , _root
  , _tempFile
  , getPath
  , hiddenTopLevel
  , isDatabase
  , isDirectory
  , isFile
  , isHidden
  , isNotebook
  , isTempFile
  , mkDatabase
  , mkDirectory
  , mkFile
  , mkNotebook
  , newDatabase
  , newDirectory
  , newFile
  , newNotebook
  , parent
  , resourceDir
  , resourceName
  , resourcePath
  , resourceTag
  , root
  , sortResource
  , fileResourceFromString
  ) where

import Config
  ( newFileName, newDatabaseName, newNotebookName, newFolderName
  , notebookExtension
  )
import Control.Bind ((=<<))
import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson)
import Data.Bifunctor (bimap)
import Data.Either (Either(..), either)
import Data.Foreign (ForeignError(TypeMismatch))
import Data.Foreign.Class (readProp, IsForeign)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Path.Pathy
  ( Path(), DirName(..), FileName(..), Abs(), Sandboxed(), Unsandboxed()
  , dirName, peel, (</>), rootDir, printPath, currentDir, file, dir
  , sandbox, parseAbsFile, parseAbsDir, renameFile, renameDir
  )
import Data.Tuple (Tuple(..), fst, snd)
import Model.Sort (Sort(..))
import Data.Lens (lens, prism', LensP(), PrismP(), (.~))
import Prelude
import Utils.Path (DirPath(), FilePath(), AnyPath(), (<./>), takeDirExt)

import qualified Data.String as S

data Resource
  = File FilePath
  | Notebook DirPath
  | Directory DirPath
  | Database DirPath

-- PREDICATES
isNotebook :: Resource -> Boolean
isNotebook (Notebook _) = true
isNotebook _ = false

isFile :: Resource -> Boolean
isFile (File _) = true
isFile _ = false

isDirectory :: Resource -> Boolean
isDirectory (Directory _) = true
isDirectory _ = false

isDatabase :: Resource -> Boolean
isDatabase (Database _) = true
isDatabase _ = false

isHidden :: Resource -> Boolean
isHidden r =
  either isHidden' isHidden' (getPath r)
  where
  isHidden' :: forall a b s. Path a b s -> Boolean
  isHidden' p = fromMaybe false do
    Tuple p' name <- peel p
    if "." == S.take 1 (nameOfFileOrDir name)
      then pure true
      else pure $ isHidden' p'

hiddenTopLevel :: Resource -> Boolean
hiddenTopLevel r = "." == S.take 1 (resourceName r)

isTempFile :: Resource -> Boolean
isTempFile r =
  (takeDirExt <$> (dirName (resourceDir r))) == Just notebookExtension

-- EMPTY
newNotebook :: Resource
newNotebook = Notebook $ rootDir </> dir newNotebookName <./> notebookExtension

newFile :: Resource
newFile = File $ rootDir </> file newFileName

newDirectory :: Resource
newDirectory = Directory $ rootDir </> dir newFolderName

newDatabase :: Resource
newDatabase = Database $ rootDir </> dir newDatabaseName

-- CONSTRUCTORS
root :: Resource
root = Directory rootDir

mkNotebook :: AnyPath -> Resource
mkNotebook ap =
  either go (Notebook <<< (<./> notebookExtension)) ap
  where
  go :: FilePath -> Resource
  go p = maybe newNotebook id do
    Tuple pp dirOrFile <- peel p
    pure $ Notebook $
      (pp </> dir (nameOfFileOrDir dirOrFile) <./> notebookExtension)

mkFile :: AnyPath -> Resource
mkFile ap = either File go ap
  where
  go :: DirPath -> Resource
  go p = maybe newFile id do
    Tuple pp dirOrFile <- peel p
    pure $ File (pp </> file (nameOfFileOrDir dirOrFile))

mkDirectory :: AnyPath -> Resource
mkDirectory ap = either go Directory ap
  where
  go :: FilePath -> Resource
  go p = maybe newDirectory id do
    Tuple pp dirOrFile <- peel p
    pure $ Directory (pp </> dir (nameOfFileOrDir dirOrFile))

mkDatabase :: AnyPath -> Resource
mkDatabase ap = either go Database ap
  where
  go :: FilePath -> Resource
  go p = maybe newDatabase id do
    Tuple pp dirOrFile <- peel p
    pure $ Database (pp </> dir (nameOfFileOrDir dirOrFile))

-- This is not real parent because it can't determine
-- is it a directory or mount
parent :: Resource -> Resource
parent = Directory <<< resourceDir

-- GETTERS
resourceTag :: Resource -> String
resourceTag r = case r of
  File _ -> "file"
  Database _ -> "mount"
  Notebook _ -> "notebook"
  Directory _ -> "directory"

resourceName :: Resource -> String
resourceName = getPath >>> getNameStr

resourceDir :: Resource -> DirPath
resourceDir = getPath >>> getDir

resourcePath :: Resource -> String
resourcePath r = either printPath printPath $ getPath r

getPath :: Resource -> AnyPath
getPath r = case r of
  File p -> Left p
  Notebook p -> Right p
  Directory p -> Right p
  Database p -> Right p

getNameStr :: AnyPath -> String
getNameStr ap = either getNameStr' getNameStr' ap
  where
  getNameStr' :: forall b a s. Path a b s -> String
  getNameStr' p = maybe "" (snd >>> nameOfFileOrDir) $ peel p

getDir :: AnyPath -> DirPath
getDir ap = either getDir' getDir' ap
  where
  getDir' :: forall b. Path Abs b Sandboxed -> DirPath
  getDir' p = maybe rootDir fst $ peel p

-- SETTERS
setDir :: AnyPath -> DirPath -> AnyPath
setDir ap d = bimap (setFile' d) (setDir' d) ap
  where
  setDir' :: DirPath -> DirPath -> DirPath
  setDir' d p =
    d </>
    (maybe currentDir (snd >>> nameOfFileOrDir >>> dir) $ peel p)

  setFile' :: DirPath -> FilePath -> FilePath
  setFile' d p =
    d </>
    (maybe (file "") (snd >>> nameOfFileOrDir >>> file) $ peel p)

setPath :: Resource -> AnyPath -> Resource
setPath (Notebook _) p = mkNotebook p
setPath (File _) p = mkFile p
setPath (Database _) p = mkDatabase p
setPath (Directory _) p = mkDirectory p

setName :: Resource -> String -> Resource
setName r name =
  setPath r ((renameAny (const name) (getPath r)))

-- MODIFIERS (PRIVATE)

renameAny :: (String -> String) -> AnyPath -> AnyPath
renameAny fn ap = bimap (renameFile $ liftFile fn) (renameDir $ liftDir fn) ap
  where
  liftFile fn (FileName a) = FileName $ fn a
  liftDir fn (DirName a) = DirName $ fn a

nameOfFileOrDir :: Either DirName FileName -> String
nameOfFileOrDir (Left (DirName name)) = name
nameOfFileOrDir (Right (FileName name)) = name

-- TRAVERSALS
_tempFile :: LensP Resource Resource
_tempFile = lens id \r s -> case r of
  File p ->
    if isTempFile r
    then s
    else r
  _ -> r

_filePath :: PrismP Resource FilePath
_filePath = prism' File $ \s -> case s of
  File fp -> Just fp
  _ -> Nothing

_path :: LensP Resource AnyPath
_path = lens getPath setPath

_nameAnyPath :: LensP AnyPath String
_nameAnyPath = lens getNameStr (\p x -> renameAny (const x) p)

_name :: LensP Resource String
_name = _path <<< _nameAnyPath

_rootAnyPath :: LensP AnyPath DirPath
_rootAnyPath = lens getDir setDir

_root :: LensP Resource DirPath
_root = _path <<< _rootAnyPath

-- INSTANCES
sortResource :: (Resource -> String) -> Sort -> Resource -> Resource -> Ordering
sortResource project direction a b
  | (isHidden a) && (not $ isHidden b) = GT
  | (isHidden b) && (not $ isHidden a) = LT
  | otherwise = case direction of
    Asc -> compare (project a) (project b)
    Desc -> compare (project b) (project a)

instance eqResource :: Eq Resource where
  eq (File p) (File p') = p == p'
  eq (Notebook p) (Notebook p') = p == p'
  eq (Directory p) (Directory p') = p == p'
  eq (Database p) (Database p') = p == p'
  eq _ _ = false

instance resourceOrd :: Ord Resource where
  compare = sortResource resourcePath Asc

instance resourceIsForeign :: IsForeign Resource where
  read f = do
    name <- readProp "name" f
    ty <- readProp "type" f
    template <- case ty of
      "mount" -> pure newDatabase
      "directory" -> pure
                     $ maybe newDirectory (const newNotebook)
                     $ S.stripSuffix notebookExtension name
      "file" -> pure newFile
      _ -> Left $ TypeMismatch "resource" "string"
    pure $ setName template name

instance encodeJsonResource :: EncodeJson Resource where
  encodeJson res =
       "type" := resourceTag res
    ~> "path" := resourcePath res
    ~> jsonEmptyObject

instance decodeJsonResource :: DecodeJson Resource where
  decodeJson json = do
    obj <- decodeJson json
    resType <- obj .? "type"
    path <- obj .? "path"
    case resType of
      "file" -> parsePath "file" File parseAbsFile path
      "notebook" -> parsePath "notebook" Notebook parseAbsDir path
      "directory" -> parsePath "directory" Directory parseAbsDir path
      "mount" -> parsePath "mount" Database parseAbsDir path
    where
    parsePath
      :: forall a b
       . String
      -> (Path Abs a Sandboxed -> Resource)
      -> (String -> Maybe (Path Abs a Unsandboxed))
      -> String
      -> Either String Resource
    parsePath ty ctor parse s =
      maybe
        (Left $ "Invalid " ++ ty ++ " path")
        (Right <<< ctor) $
          (rootDir </>) <$> (sandbox rootDir =<< parse s)

fileResourceFromString
  :: String
  -> Either String Resource
fileResourceFromString path =
  case (rootDir </>) <$> (parseAbsFile path >>= sandbox rootDir) of
    Just path' -> Right $ newFile # _path .~ Left path'
    Nothing -> Left path

{-
Copyright 2015 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 Model.Resource
  ( Resource(..)
  , _filePath
  , _name
  , _nameAnyPath
  , _path
  , _root
  , _tempFile
  , getPath
  , hiddenTopLevel
  , isDatabase
  , isDirectory
  , isFile
  , isHidden
  , isNotebook
  , isTempFile
  , mkDatabase
  , mkDirectory
  , mkFile
  , mkNotebook
  , newDatabase
  , newDirectory
  , newFile
  , newNotebook
  , parent
  , resourceDir
  , resourceName
  , resourcePath
  , resourceTag
  , root
  , sortResource
  , fileResourceFromString
  ) where

import Config
  ( newFileName, newDatabaseName, newNotebookName, newFolderName
  , notebookExtension
  )
import Control.Bind ((=<<))
import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson)
import Data.Bifunctor (bimap)
import Data.Either (Either(..), either)
import Data.Foreign (ForeignError(TypeMismatch))
import Data.Foreign.Class (readProp, IsForeign)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Path.Pathy
  ( Path(), DirName(..), FileName(..), Abs(), Sandboxed(), dirName, peel, (</>)
  , rootDir, printPath, rootDir, currentDir, file, dir, sandbox, parseAbsFile
  , parseAbsDir, renameFile, renameDir
  )
import Data.Tuple (Tuple(..), fst, snd)
import Model.Sort (Sort(..))
import Data.Lens (lens, prism', LensP(), PrismP(), (.~))
import Prelude
import Utils.Path (DirPath(), FilePath(), AnyPath(), (<./>), takeDirExt)

import qualified Data.String as S

data Resource
  = File FilePath
  | Notebook DirPath
  | Directory DirPath
  | Database DirPath

-- PREDICATES
isNotebook :: Resource -> Boolean
isNotebook (Notebook _) = true
isNotebook _ = false

isFile :: Resource -> Boolean
isFile (File _) = true
isFile _ = false

isDirectory :: Resource -> Boolean
isDirectory (Directory _) = true
isDirectory _ = false

isDatabase :: Resource -> Boolean
isDatabase (Database _) = true
isDatabase _ = false

isHidden :: Resource -> Boolean
isHidden r =
  either isHidden' isHidden' (getPath r)
  where
  isHidden' :: forall a b s. Path a b s -> Boolean
  isHidden' p = fromMaybe false do
    Tuple p' name <- peel p
    if "." == S.take 1 (nameOfFileOrDir name)
      then pure true
      else pure $ isHidden' p'

hiddenTopLevel :: Resource -> Boolean
hiddenTopLevel r = "." == S.take 1 (resourceName r)

isTempFile :: Resource -> Boolean
isTempFile r =
  (takeDirExt <$> (dirName (resourceDir r))) == Just notebookExtension

-- EMPTY
newNotebook :: Resource
newNotebook = Notebook $ rootDir </> dir newNotebookName <./> notebookExtension

newFile :: Resource
newFile = File $ rootDir </> file newFileName

newDirectory :: Resource
newDirectory = Directory $ rootDir </> dir newFolderName

newDatabase :: Resource
newDatabase = Database $ rootDir </> dir newDatabaseName

-- CONSTRUCTORS
root :: Resource
root = Directory rootDir

mkNotebook :: AnyPath -> Resource
mkNotebook ap =
  either go (Notebook <<< (<./> notebookExtension)) ap
  where
  go :: FilePath -> Resource
  go p = maybe newNotebook id do
    Tuple pp dirOrFile <- peel p
    pure $ Notebook $
      (pp </> dir (nameOfFileOrDir dirOrFile) <./> notebookExtension)

mkFile :: AnyPath -> Resource
mkFile ap = either File go ap
  where
  go :: DirPath -> Resource
  go p = maybe newFile id do
    Tuple pp dirOrFile <- peel p
    pure $ File (pp </> file (nameOfFileOrDir dirOrFile))

mkDirectory :: AnyPath -> Resource
mkDirectory ap = either go Directory ap
  where
  go :: FilePath -> Resource
  go p = maybe newDirectory id do
    Tuple pp dirOrFile <- peel p
    pure $ Directory (pp </> dir (nameOfFileOrDir dirOrFile))

mkDatabase :: AnyPath -> Resource
mkDatabase ap = either go Database ap
  where
  go :: FilePath -> Resource
  go p = maybe newDatabase id do
    Tuple pp dirOrFile <- peel p
    pure $ Database (pp </> dir (nameOfFileOrDir dirOrFile))

-- This is not real parent because it can't determine
-- is it a directory or mount
parent :: Resource -> Resource
parent = Directory <<< resourceDir

-- GETTERS
resourceTag :: Resource -> String
resourceTag r = case r of
  File _ -> "file"
  Database _ -> "mount"
  Notebook _ -> "notebook"
  Directory _ -> "directory"

resourceName :: Resource -> String
resourceName = getPath >>> getNameStr

resourceDir :: Resource -> DirPath
resourceDir = getPath >>> getDir

resourcePath :: Resource -> String
resourcePath r = either printPath printPath $ getPath r

getPath :: Resource -> AnyPath
getPath r = case r of
  File p -> Left p
  Notebook p -> Right p
  Directory p -> Right p
  Database p -> Right p

getNameStr :: AnyPath -> String
getNameStr ap = either getNameStr' getNameStr' ap
  where
  getNameStr' :: forall b a s. Path a b s -> String
  getNameStr' p = maybe "" (snd >>> nameOfFileOrDir) $ peel p

getDir :: AnyPath -> DirPath
getDir ap = either getDir' getDir' ap
  where
  getDir' :: forall b. Path Abs b Sandboxed -> DirPath
  getDir' p = maybe rootDir fst $ peel p

-- SETTERS
setDir :: AnyPath -> DirPath -> AnyPath
setDir ap d = bimap (setFile' d) (setDir' d) ap
  where
  setDir' :: DirPath -> DirPath -> DirPath
  setDir' d p =
    d </>
    (maybe currentDir (snd >>> nameOfFileOrDir >>> dir) $ peel p)

  setFile' :: DirPath -> FilePath -> FilePath
  setFile' d p =
    d </>
    (maybe (file "") (snd >>> nameOfFileOrDir >>> file) $ peel p)

setPath :: Resource -> AnyPath -> Resource
setPath (Notebook _) p = mkNotebook p
setPath (File _) p = mkFile p
setPath (Database _) p = mkDatabase p
setPath (Directory _) p = mkDirectory p

setName :: Resource -> String -> Resource
setName r name =
  setPath r ((renameAny (const name) (getPath r)))

-- MODIFIERS (PRIVATE)

renameAny :: (String -> String) -> AnyPath -> AnyPath
renameAny fn ap = bimap (renameFile $ liftFile fn) (renameDir $ liftDir fn) ap
  where
  liftFile fn (FileName a) = FileName $ fn a
  liftDir fn (DirName a) = DirName $ fn a

nameOfFileOrDir :: Either DirName FileName -> String
nameOfFileOrDir (Left (DirName name)) = name
nameOfFileOrDir (Right (FileName name)) = name

-- TRAVERSALS
_tempFile :: LensP Resource Resource
_tempFile = lens id \r s -> case r of
  File p ->
    if isTempFile r
    then s
    else r
  _ -> r

_filePath :: PrismP Resource FilePath
_filePath = prism' File $ \s -> case s of
  File fp -> Just fp
  _ -> Nothing

_path :: LensP Resource AnyPath
_path = lens getPath setPath

_nameAnyPath :: LensP AnyPath String
_nameAnyPath = lens getNameStr (\p x -> renameAny (const x) p)

_name :: LensP Resource String
_name = _path <<< _nameAnyPath

_rootAnyPath :: LensP AnyPath DirPath
_rootAnyPath = lens getDir setDir

_root :: LensP Resource DirPath
_root = _path <<< _rootAnyPath

-- INSTANCES
sortResource :: (Resource -> String) -> Sort -> Resource -> Resource -> Ordering
sortResource project direction a b
  | (isHidden a) && (not $ isHidden b) = GT
  | (isHidden b) && (not $ isHidden a) = LT
  | otherwise = case direction of
    Asc -> compare (project a) (project b)
    Desc -> compare (project b) (project a)

instance eqResource :: Eq Resource where
  eq (File p) (File p') = p == p'
  eq (Notebook p) (Notebook p') = p == p'
  eq (Directory p) (Directory p') = p == p'
  eq (Database p) (Database p') = p == p'
  eq _ _ = false

instance resourceOrd :: Ord Resource where
  compare = sortResource resourcePath Asc

instance resourceIsForeign :: IsForeign Resource where
  read f = do
    name <- readProp "name" f
    ty <- readProp "type" f
    template <- case ty of
      "mount" -> pure newDatabase
      "directory" -> pure
                     $ maybe newDirectory (const newNotebook)
                     $ S.stripSuffix notebookExtension name
      "file" -> pure newFile
      _ -> Left $ TypeMismatch "resource" "string"
    pure $ setName template name

instance encodeJsonResource :: EncodeJson Resource where
  encodeJson res =
       "type" := resourceTag res
    ~> "path" := resourcePath res
    ~> jsonEmptyObject

instance decodeJsonResource :: DecodeJson Resource where
  decodeJson json = do
    obj <- decodeJson json
    resType <- obj .? "type"
    path <- obj .? "path"
    case resType of
      -- type inference bug prevents use of a generic `parsePath` which accepts
      -- `parseAbsFile` or `parseAbsDir` as an argument
      "file" -> maybe (Left $ "Invalid file path") (Right <<< File)
                $ (rootDir </>) <$> (sandbox rootDir =<< parseAbsFile path)
      "notebook" -> parseDirPath "notebook" Notebook path
      "directory" -> parseDirPath "directory" Directory path
      "mount" -> parseDirPath "mount" Database path
      _ -> Left "Unrecognized resource type"
    where
    parseDirPath :: String -> (DirPath -> Resource) -> String
                    -> Either String Resource
    parseDirPath ty ctor s =
      maybe (Left $ "Invalid " ++ ty ++ " path") (Right <<< ctor) $
        (rootDir </>) <$> (sandbox rootDir =<< parseAbsDir s)

fileResourceFromString
  :: String
  -> Either String Resource
fileResourceFromString path =
  case (rootDir </>) <$> (parseAbsFile path >>= sandbox rootDir) of
    Just path' -> Right $ newFile # _path .~ Left path'
    Nothing -> Left path