content: {-# OPTIONS_GHC -fno-warn-unused-binds #-}
  {-# LANGUAGE OverloadedStrings, ForeignFunctionInterface, CPP, MagicHash,
               GeneralizedNewtypeDeriving #-}
  -- | JSString standard functions, to make them a more viable alternative to
  --   the horribly inefficient standard Strings.
  --
  --   Many functions have linear time complexity due to JavaScript engines not
  --   implementing slicing, etc. in constant time.
  --
  --   All functions are supported on both client and server, with the exception
  --   of 'match', 'matches', 'regex' and 'replace', which are wrappers on top of
  --   JavaScript's native regular expressions and thus only supported on the
  --   client.
  module Haste.JSString
    ( JSString
    -- * Building JSStrings
    , empty, singleton, pack, cons, snoc, append, replicate
      -- * Deconstructing JSStrings
    , (!), unpack, head, last, tail, drop, take, init, splitAt
      -- * Examining JSStrings
    , null, length, any, all
      -- * Modifying JSStrings
    , map, reverse, intercalate, foldl', foldr, concat, concatMap
      -- * Regular expressions (client-side only)
    , RegEx, match, matches, regex, replace
      -- * JSString I/O
    , putStrLn, putStr
    ) where
  import qualified Data.List
  import Prelude hiding (foldr, concat, concatMap, reverse, map, all, any,
                         length, null, splitAt, init, take, drop, tail, head,
                         last, replicate, putStrLn, putStr)
  import qualified Prelude
  import Data.String
  import Haste.Prim
  import Haste.Prim.Foreign
  import Control.Monad.IO.Class
  import System.IO.Unsafe
  
  #ifdef __HASTE__
  import GHC.Prim
  
  {-# INLINE d2c #-}
  d2c :: Double -> Char
  d2c d = unsafeCoerce# d
  
  _jss_singleton :: Char -> IO JSString
  _jss_singleton = ffi "String.fromCharCode"
  
  _jss_cons :: Char -> JSString -> IO JSString
  _jss_cons = ffi "(function(c,s){return String.fromCharCode(c)+s;})"
  
  _jss_snoc :: JSString -> Char -> IO JSString
  _jss_snoc = ffi "(function(s,c){return s+String.fromCharCode(c);})"
  
  _jss_append :: JSString -> JSString -> IO JSString
  _jss_append = ffi "(function(a,b){return a+b;})"
  
  _jss_len :: JSString -> IO Int
  _jss_len = ffi "(function(s){return s.length;})"
  
  _jss_index :: JSString -> Int -> IO Double
  _jss_index = ffi "(function(s,i){return s.charCodeAt(i);})"
  
  _jss_substr :: JSString -> Int -> IO JSString
  _jss_substr = ffi "(function(s,x){return s.substr(x);})"
  
  _jss_take :: Int -> JSString -> IO JSString
  _jss_take = ffi "(function(n,s){return s.substr(0,n);})"
  
  _jss_rev :: JSString -> IO JSString
  _jss_rev = ffi "(function(s){return s.split('').reverse().join('');})"
  
  _jss_re_match :: JSString -> RegEx -> IO Bool
  _jss_re_match = ffi "(function(s,re){return s.search(re)>=0;})"
  
  _jss_re_compile :: JSString -> JSString -> IO RegEx
  _jss_re_compile = ffi "(function(re,fs){return new RegExp(re,fs);})"
  
  _jss_re_replace :: JSString -> RegEx -> JSString -> IO JSString
  _jss_re_replace = ffi "(function(s,re,rep){return s.replace(re,rep);})"
  
  _jss_re_find :: RegEx -> JSString -> IO [JSString]
  _jss_re_find = ffi "(function(re,s) {\
  var a = s.match(re);\
  return a ? a : [];})"
  
  {-# INLINE _jss_map #-}
  _jss_map :: (Char -> Char) -> JSString -> JSString
  _jss_map f s = unsafePerformIO $ cmap_js (_jss_singleton . f) s
  
  {-# INLINE _jss_cmap #-}
  _jss_cmap :: (Char -> JSString) -> JSString -> JSString
  _jss_cmap f s = unsafePerformIO $ cmap_js (return . f) s
  
  cmap_js :: (Char -> IO JSString) -> JSString -> IO JSString
  cmap_js = ffi "(function(f,s){\
  var s2 = '';\
  for(var i in s) {\
     s2 += f(s.charCodeAt(i));\
  }\
  return s2;})"
  
  {-# INLINE _jss_foldl #-}
  _jss_foldl :: (ToAny a, FromAny a) => (a -> Char -> a) -> a -> JSString -> a
  _jss_foldl f x s = fromOpaque . unsafePerformIO $ do
    foldl_js (\a c ->  toOpaque $ f (fromOpaque a) c) (toOpaque x) s
  
  foldl_js :: (Opaque a -> Char -> Opaque a)
           -> Opaque a
           -> JSString
           -> IO (Opaque a)
  foldl_js = ffi "(function(f,x,s){\
  for(var i in s) {\
    x = f(x,s.charCodeAt(i));\
  }\
  return x;})"
  
  {-# INLINE _jss_foldr #-}
  _jss_foldr :: (ToAny a, FromAny a) => (Char -> a -> a) -> a -> JSString -> a
  _jss_foldr f x s = fromOpaque . unsafePerformIO $ do
    foldr_js (\c -> toOpaque . f c . fromOpaque) (toOpaque x) s
  
  foldr_js :: (Char -> Opaque a -> Opaque a)
           -> Opaque a
           -> JSString
           -> IO (Opaque a)
  foldr_js = ffi "(function(f,x,s){\
  for(var i = s.length-1; i >= 0; --i) {\
    x = f(s.charCodeAt(i),x);\
  }\
  return x;})"
  
  #else
  
  {-# INLINE d2c #-}
  d2c :: Char -> Char
  d2c = id
  
  _jss_singleton :: Char -> IO JSString
  _jss_singleton c = return $ toJSStr [c]
  
  _jss_cons :: Char -> JSString -> IO JSString
  _jss_cons c s = return $ toJSStr (c : fromJSStr s)
  
  _jss_snoc :: JSString -> Char -> IO JSString
  _jss_snoc s c = return $ toJSStr (fromJSStr s ++ [c])
  
  _jss_append :: JSString -> JSString -> IO JSString
  _jss_append a b = return $ catJSStr "" [a, b]
  
  _jss_len :: JSString -> IO Int
  _jss_len s = return $ Data.List.length $ fromJSStr s
  
  _jss_index :: JSString -> Int -> IO Char
  _jss_index s n = return $ fromJSStr s !! n
  
  _jss_substr :: JSString -> Int -> IO JSString
  _jss_substr s n = return $ toJSStr $ Data.List.drop n $ fromJSStr s
  
  _jss_take :: Int -> JSString -> IO JSString
  _jss_take n = return . toJSStr . Data.List.take n . fromJSStr
  
  _jss_map :: (Char -> Char) -> JSString -> JSString
  _jss_map f = toJSStr . Data.List.map f . fromJSStr
  
  _jss_cmap :: (Char -> JSString) -> JSString -> JSString
  _jss_cmap f =
    toJSStr . Data.List.concat . Data.List.map (fromJSStr . f) . fromJSStr
  
  _jss_rev :: JSString -> IO JSString
  _jss_rev = return . toJSStr . Data.List.reverse . fromJSStr
  
  _jss_foldl :: (a -> Char -> a) -> a -> JSString -> a
  _jss_foldl f x = Data.List.foldl' f x . fromJSStr
  
  _jss_foldr :: (Char -> a -> a) -> a -> JSString -> a
  _jss_foldr f x = Data.List.foldr f x . fromJSStr
  
  _jss_re_compile :: JSString -> JSString -> IO RegEx
  _jss_re_compile _ _ =
    error "Regular expressions are only supported client-side!"
  
  _jss_re_match :: JSString -> RegEx -> IO Bool
  _jss_re_match _ _ =
    error "Regular expressions are only supported client-side!"
  
  _jss_re_replace :: JSString -> RegEx -> JSString -> IO JSString
  _jss_re_replace _ _ _ =
    error "Regular expressions are only supported client-side!"
  
  _jss_re_find :: RegEx -> JSString -> IO [JSString]
  _jss_re_find _ _ =
    error "Regular expressions are only supported client-side!"
  
  #endif
  
  -- | A regular expression. May be used to match and replace JSStrings.
  newtype RegEx = RegEx JSAny
    deriving (ToAny, FromAny)
  
  instance IsString RegEx where
    fromString s = unsafePerformIO $ _jss_re_compile (fromString s) ""
  
  -- | O(1) The empty JSString.
  empty :: JSString
  empty = ""
  
  -- | O(1) JSString consisting of a single character.
  singleton :: Char -> JSString
  singleton = veryUnsafePerformIO . _jss_singleton
  
  -- | O(n) Convert a list of Char into a JSString.
  pack :: [Char] -> JSString
  pack = toJSStr
  
  -- | O(n) Convert a JSString to a list of Char.
  unpack :: JSString -> [Char]
  unpack = fromJSStr
  
  infixr 5 `cons`
  -- | O(n) Prepend a character to a JSString.
  cons :: Char -> JSString -> JSString
  cons c s = veryUnsafePerformIO $ _jss_cons c s
  
  infixl 5 `snoc`
  -- | O(n) Append a character to a JSString.
  snoc :: JSString -> Char -> JSString
  snoc s c = veryUnsafePerformIO $ _jss_snoc s c
  
  -- | O(n) Append two JSStrings.
  append :: JSString -> JSString -> JSString
  append a b = veryUnsafePerformIO $ _jss_append a b
  
  -- | O(1) Extract the first element of a non-empty JSString.
  head :: JSString -> Char
  head s =
  #ifdef __HASTE__
    case veryUnsafePerformIO $ _jss_index s 0 of
      c | isNaN c   -> error "Haste.JSString.head: empty JSString"
        | otherwise -> d2c c -- Double/Int/Char share representation.
  #else
    Data.List.head $ fromJSStr s
  #endif
  
  -- | O(1) Extract the last element of a non-empty JSString.
  last :: JSString -> Char
  last s =
    case veryUnsafePerformIO $ _jss_len s of
      0 -> error "Haste.JSString.head: empty JSString"
      n -> d2c (veryUnsafePerformIO $ _jss_index s (n-1))
  
  -- | Get a single character from a JSString.
  (!) :: JSString -> Int -> Char
  s ! n =
  #ifdef __HASTE__
    case veryUnsafePerformIO $ _jss_index s n of
      c | isNaN c   -> error "Haste.JSString.(!): index out of bounds"
        | otherwise -> d2c c -- Double/Int/Char share representation.
  #else
    fromJSStr s !! n
  #endif
  
  
  -- | O(n) All elements but the first of a JSString. Returns an empty JSString
  --   if the given JSString is empty.
  tail :: JSString -> JSString
  tail s = veryUnsafePerformIO $ _jss_substr s 1
  
  -- | O(n) Drop 'n' elements from the given JSString.
  drop :: Int -> JSString -> JSString
  drop n s = veryUnsafePerformIO $ _jss_substr s (max 0 n)
  
  -- | O(n) Take 'n' elements from the given JSString.
  take :: Int -> JSString -> JSString
  take n s = veryUnsafePerformIO $ _jss_take n s
  
  -- | O(n) All elements but the last of a JSString. Returns an empty JSString
  --   if the given JSString is empty.
  init :: JSString -> JSString
  init s = veryUnsafePerformIO $ _jss_take (veryUnsafePerformIO (_jss_len s)-1) s
  
  -- | O(1) Test whether a JSString is empty.
  null :: JSString -> Bool
  null s = veryUnsafePerformIO (_jss_len s) == 0
  
  -- | O(1) Get the length of a JSString as an Int.
  length :: JSString -> Int
  length = veryUnsafePerformIO . _jss_len
  
  -- | O(n) Map a function over the given JSString.
  map :: (Char -> Char) -> JSString -> JSString
  map f s = _jss_map f s
  
  -- | O(n) reverse a JSString.
  reverse :: JSString -> JSString
  reverse = veryUnsafePerformIO . _jss_rev
  
  -- | O(n) Join a list of JSStrings, with a specified separator. Equivalent to
  --   'String.join'.
  intercalate :: JSString -> [JSString] -> JSString
  intercalate = catJSStr
  
  -- | O(n) Left fold over a JSString.
  foldl' :: (ToAny a, FromAny a) => (a -> Char -> a) -> a -> JSString -> a
  foldl' = _jss_foldl
  
  -- | O(n) Right fold over a JSString.
  foldr :: (ToAny a, FromAny a) => (Char -> a -> a) -> a -> JSString -> a
  foldr = _jss_foldr
  
  -- | O(n) Concatenate a list of JSStrings.
  concat :: [JSString] -> JSString
  concat = catJSStr ""
  
  -- | O(n) Map a function over a JSString, then concatenate the results.
  --   Note that this function is actually faster than 'map' in most cases.
  concatMap :: (Char -> JSString) -> JSString -> JSString
  concatMap = _jss_cmap
  
  -- | O(n) Determines whether any character in the string satisfies the given
  --   predicate.
  any :: (Char -> Bool) -> JSString -> Bool
  any p = Haste.JSString.foldl' (\a x -> a || p x) False
  
  -- | O(n) Determines whether all characters in the string satisfy the given
  --   predicate.
  all :: (Char -> Bool) -> JSString -> Bool
  all p = Haste.JSString.foldl' (\a x -> a && p x) False
  
  -- | O(n) Create a JSString containing 'n' instances of a single character.
  replicate :: Int -> Char -> JSString
  replicate n c = Haste.JSString.pack $ Data.List.replicate n c
  
  -- | O(n) Equivalent to (take n xs, drop n xs).
  splitAt :: Int -> JSString -> (JSString, JSString)
  splitAt n s = (Haste.JSString.take n s, Haste.JSString.drop n s)
  
  -- | As 'Prelude.putStrLn'.
  putStrLn :: MonadIO m => JSString -> m ()
  putStrLn = liftIO . Prelude.putStrLn . unpack
  
  -- | As 'Prelude.putStr'.
  putStr :: MonadIO m => JSString -> m ()
  putStr = liftIO . Prelude.putStr . unpack
  
  -- | O(n) Determines whether the given JSString matches the given regular
  --   expression or not.
  matches :: JSString -> RegEx -> Bool
  matches s re = veryUnsafePerformIO $ _jss_re_match s re
  
  -- | O(n) Find all strings corresponding to the given regular expression.
  match :: RegEx -> JSString -> [JSString]
  match re s = veryUnsafePerformIO $ _jss_re_find re s
  
  -- | O(n) Compile a regular expression and an (optionally empty) list of flags
  --   into a 'RegEx' which can be used to match, replace, etc. on JSStrings.
  --
  --   The regular expression and flags are passed verbatim to the browser's
  --   RegEx constructor, meaning that the syntax is the same as when using
  --   regular expressions in raw JavaScript.
  regex :: JSString -- ^ Regular expression.
        -> JSString -- ^ Potential flags.
        -> RegEx
  regex re flags = veryUnsafePerformIO $ _jss_re_compile re flags
  
  -- | O(n) String substitution using regular expressions.
  replace :: JSString -- ^ String perform substitution on.
          -> RegEx    -- ^ Regular expression to match.
          -> JSString -- ^ Replacement string.
          -> JSString
  replace s re rep = veryUnsafePerformIO $ _jss_re_replace s re rep
  