fay-base 0.19.2.1 → 0.19.3

raw patch · 19 files changed

+1235/−14 lines, 19 filesdep ~fayPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: fay

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• fay-base.cabal +35/−14
• src/Control/Exception.hs +17/−0
• src/Data/Defined.hs +15/−0
• src/Data/Either.hs +25/−0
• src/Data/Function.hs +23/−0
• src/Data/List.hs +101/−0
• src/Data/LocalStorage.hs +19/−0
• src/Data/Maybe.hs +102/−0
• src/Data/MutMap.hs +122/−0
• src/Data/MutMap/Internal.hs +20/−0
• src/Data/Mutex.hs +44/−0
• src/Data/Nullable.hs +16/−0
• src/Data/Ord.hs +13/−0
• src/Data/Text.hs +282/−0
• src/Data/Time.hs +68/−0
• src/Data/Var.hs +302/−0
• src/Fay/Unsafe.hs +9/−0
• src/Unsafe/Coerce.hs +8/−0

@@ -1,5 +1,19 @@ ## Changelog +### 0.19.3 (2014-10-21)++* Lots of additions adding the following modules:+  * Data.Var - Mutable variables, Reactive variables, and reactive signals+  * Unsafe.Coerce+  * Data.Text (fay-text will be updated to reuse this module)+  * Data.Time+  * Data.Ord, Data.Function, Data.Maybe, Data.List, Data.Either+  * Data.Defined and Data.Nullable+  * Data.Mutex - Simple mutexes+  * Control.Exception+  * Data.LocalStorage+  * Data.MutMap - Mutable maps+ #### 0.19.2.1 (2014-10-11)  * Allow `fay 0.21`

@@ -1,5 +1,5 @@ name:                fay-base-version:             0.19.2.1+version:             0.19.3 synopsis:            The base package for Fay. description:         The base package for Fay.                      This package amongst others exports Prelude and FFI which you probably want to use with Fay.@@ -18,12 +18,13 @@   README.md   CHANGELOG.md data-files:-  src/Prelude.hs-  src/FFI.hs-  src/Data/Data.hs-  src/Data/Char.hs-  src/Data/Ratio.hs-  src/Debug/Trace.hs+  src/*.hs+  src/Control/*.hs+  src/Data/*.hs+  src/Data/MutMap/*.hs+  src/Debug/*.hs+  src/Fay/*.hs+  src/Unsafe/*.hs  source-repository head   type: git@@ -32,10 +33,30 @@ library   hs-source-dirs:    src   exposed:           False-  exposed-modules:   Prelude-                    ,FFI-                    ,Data.Char-                    ,Data.Data-                    ,Data.Ratio-                    ,Debug.Trace-  build-depends: base == 4.*, fay >= 0.19.1 && < 0.22+  exposed-modules:+    Control.Exception+    Data.Char+    Data.Data+    Data.Defined+    Data.Either+    Data.Function+    Data.List+    Data.LocalStorage+    Data.Maybe+    Data.MutMap+    Data.MutMap.Internal+    Data.Mutex+    Data.Nullable+    Data.Ord+    Data.Ratio+    Data.Text+    Data.Time+    Data.Var+    Debug.Trace+    FFI+    Fay.Unsafe+    Prelude+    Unsafe.Coerce+  build-depends:+      base == 4.*+    , fay >= 0.21.1 && < 0.22

@@ -0,0 +1,17 @@+-- | Exception handling.++module Control.Exception where++import FFI++-- | Try the given action and catch if there's an error.+onException :: Fay a -> Fay a -> Fay a+onException = ffi "function() { try { return %1(); } catch(e) { return %2(); } }()"++-- | Try the given action and catch the exception.+catch :: Fay a -> (Automatic e -> Fay a) -> Fay a+catch = ffi "function() { try { return %1(); } catch(e) { return %2(e); } }()"++-- | Throw an exception.+throw :: Automatic e -> Fay a+throw = ffi "(function() { throw %1 })()"

@@ -0,0 +1,15 @@+-- | Functions for the 'Defined' type.++module Data.Defined where++import FFI++-- | Convert from defined to maybe.+fromDefined :: Defined a -> Maybe a+fromDefined (Defined x) = Just x+fromDefined Undefined = Nothing++-- | Convert from maybe to defined.+toDefined :: Maybe a -> Defined a+toDefined (Just x) = Defined x+toDefined Nothing = Undefined

@@ -0,0 +1,25 @@+-- | Either operations.++module Data.Either where++import Prelude++-- | Basically forM.+whenLeft :: Either a b -> (a -> Fay c) -> Fay (Maybe c)+whenLeft (Left x) f = f x >>= return . Just+whenLeft (Right _) _ = return Nothing++-- | Basically forM.+whenRight :: Either a b -> (b -> Fay c) -> Fay (Maybe c)+whenRight (Right x) f = f x >>= return . Just+whenRight (Left _) _ = return Nothing++-- | Usual isLeft.+isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _ = False++-- | Usual isRight.+isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _ = False

@@ -0,0 +1,23 @@+-- | Functions++module Data.Function where++import Prelude++-- | (*) `on` f = \x y -> f x * f y.+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c+on f g x y = f (g x) (g y)++-- | The \"f\" is for \"Fay\", not \"Functor\" ;)+fmap :: (a -> b) -> Fay a -> Fay b+fmap f a = a >>= return . f++-- | See '<*>'.+ap :: Fay (a -> b) -> Fay a -> Fay b+ap m g = do f <- m+            x <- g+            return (f x)++-- | A la Control.Applicative.+(<*>) :: Fay (a -> b) -> Fay a -> Fay b+(<*>) = ap

@@ -0,0 +1,101 @@+{-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE EmptyDataDecls    #-}+{-# LANGUAGE StandaloneDeriving #-}++module Data.List where++import Prelude+import Data.Maybe++-- | The 'isPrefixOf' function takes two lists and returns 'True'+-- iff the first list is a prefix of the second.+isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool+isPrefixOf [] _         =  True+isPrefixOf _  []        =  False+isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys++-- | The 'isSuffixOf' function takes two lists and returns 'True'+-- iff the first list is a suffix of the second.+-- Both lists must be finite.+isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool+isSuffixOf x y          =  reverse x `isPrefixOf` reverse y++-- | The 'stripPrefix' function drops the given prefix from a list.+-- It returns 'Nothing' if the list did not start with the prefix+-- given, or 'Just' the list after the prefix, if it does.+--+-- > stripPrefix "foo" "foobar" == Just "bar"+-- > stripPrefix "foo" "foo" == Just ""+-- > stripPrefix "foo" "barfoo" == Nothing+-- > stripPrefix "foo" "barfoobaz" == Nothing+stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]+stripPrefix [] ys = Just ys+stripPrefix (x:xs) (y:ys)+ | x == y = stripPrefix xs ys+stripPrefix _ _ = Nothing++-- | Like 'stripPrefix', but drops the given suffix from the end.+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix x y = onJust reverse $ reverse x `stripPrefix` reverse y++-- | Split lists at delimiter specified by a condition+--   Drops empty groups (similar to `words`)+splitWhen :: (a -> Bool) -> [a] -> [[a]]+splitWhen p s = case dropWhile p s of+  [] -> []+  s' -> case break p s' of+    (w, s'') -> w : splitWhen p s''++-- | Split lists at the specified delimiter+--   Drops empty groups (similar to `words`)+splitOn :: Eq a => a -> [a] -> [[a]]+splitOn c = splitWhen (==c)++-- | The 'partition' function takes a predicate a list and returns+-- the pair of lists of elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p xs == (filter p xs, filter (not . p) xs)++partition :: (a -> Bool) -> [a] -> ([a],[a])+partition p xs = (filter p xs, filter (not . p) xs)+{-+-- Fay doesn't support irrefutable patterns+partition :: (a -> Bool) -> [a] -> ([a],[a])+partition p = foldr (select p) ([],[])+  where+    select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])+    select p x ~(ts,fs) | p x       = (x:ts,fs)+                        | otherwise = (ts, x:fs)+-}++-- | The 'inits' function returns all initial segments of the argument,+-- shortest first.  For example,+--+-- > inits "abc" == ["","a","ab","abc"]+--+-- Note that 'inits' has the following strictness property:+-- @inits _|_ = [] : _|_@+inits                   :: [a] -> [[a]]+inits xs                =  [] : case xs of+                                  []      -> []+                                  x : xs' -> map (x :) (inits xs')++-- This one /isn't/ from Data.List+groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]+groupSortBy f = groupBy (\x y -> f x y == EQ) . sortBy f++-- | Classic group by.+groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy _  []           =  []+groupBy eq (x:xs)       =  case span (eq x) xs of+  (ys,zs) -> (x:ys) : groupBy eq zs++-- | Belongs in Control.Monad, right?+findM :: (a -> Fay (Maybe b)) -> [a] -> Fay (Maybe b)+findM _ [] = return Nothing+findM f (x:xs) = do+  b <- f x+  case b of+    Nothing -> findM f xs+    Just _ -> return b

@@ -0,0 +1,19 @@+-- | Simple local storage bindings.++module Data.LocalStorage where++import Data.Text+import FFI+import Prelude++setLocalStorage :: Text -> Text -> Fay ()+setLocalStorage = ffi "(function() { localStorage[%1] = %2; })()"++getLocalStorage :: Text -> Fay (Defined Text)+getLocalStorage = ffi "localStorage[%1]"++removeLocalStorage :: Text -> Fay ()+removeLocalStorage = ffi "localStorage.removeItem(%1)"++hasLocalStorage :: Bool+hasLocalStorage = ffi "typeof(Storage) !== 'undefined'"

@@ -0,0 +1,102 @@+-- | Maybe functions.++module Data.Maybe+  (-- * General operations from base+  isJust+  ,isNothing+  ,fromJust+  ,fromMaybe+  ,maybeToList+  ,listToMaybe+  ,catMaybes+  ,mapMaybe+  ,mapMaybeFB+  -- * Fay helpers+  ,whenJust+  ,whenJust'+  ,onJust+  ,joinMaybe)+ where++import Prelude++-- ---------------------------------------------------------------------------+-- Functions over Maybe++-- | The 'isJust' function returns 'True' iff its argument is of the+-- form @Just _@.+isJust         :: Maybe a -> Bool+isJust Nothing = False+isJust _       = True++-- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.+isNothing         :: Maybe a -> Bool+isNothing Nothing = True+isNothing _       = False++-- | The 'fromJust' function extracts the element out of a 'Just' and+-- throws an error if its argument is 'Nothing'.+fromJust          :: Maybe a -> a+fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck+fromJust (Just x) = x++-- | The 'fromMaybe' function takes a default value and and 'Maybe'+-- value.  If the 'Maybe' is 'Nothing', it returns the default values;+-- otherwise, it returns the value contained in the 'Maybe'.+fromMaybe     :: a -> Maybe a -> a+fromMaybe d x = case x of {Nothing -> d;Just v  -> v}++-- | The 'maybeToList' function returns an empty list when given+-- 'Nothing' or a singleton list when not given 'Nothing'.+maybeToList            :: Maybe a -> [a]+maybeToList  Nothing   = []+maybeToList  (Just x)  = [x]++-- | The 'listToMaybe' function returns 'Nothing' on an empty list+-- or @'Just' a@ where @a@ is the first element of the list.+listToMaybe           :: [a] -> Maybe a+listToMaybe []        =  Nothing+listToMaybe (a:_)     =  Just a++-- | The 'catMaybes' function takes a list of 'Maybe's and returns+-- a list of all the 'Just' values.+catMaybes              :: [Maybe a] -> [a]+catMaybes ls = [x | Just x <- ls]++-- | The 'mapMaybe' function is a version of 'map' which can throw+-- out elements.  In particular, the functional argument returns+-- something of type @'Maybe' b@.  If this is 'Nothing', no element+-- is added on to the result list.  If it just @'Just' b@, then @b@ is+-- included in the result list.+mapMaybe          :: (a -> Maybe b) -> [a] -> [b]+mapMaybe _ []     = []+mapMaybe f (x:xs) =+ let rs = mapMaybe f xs in+ case f x of+  Nothing -> rs+  Just r  -> r:rs++mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r+mapMaybeFB cons f x next = case f x of+  Nothing -> next+  Just r -> cons r next++-- | Handy alternative to not having forM.+whenJust :: Maybe a -> (a -> Fay ()) -> Fay ()+whenJust (Just x) f = f x+whenJust Nothing _ = return ()++-- | Similar to forM again.+whenJust' :: Maybe a -> (a -> Fay b) -> Fay (Maybe b)+whenJust' (Just x) f = f x >>= return . Just+whenJust' Nothing _ = return Nothing++-- | Basically fmap for Maybe.+onJust :: (a -> b) -> Maybe a -> Maybe b+onJust f (Just x) = Just (f x)+onJust _ Nothing = Nothing++-- | Join for Maybe.+joinMaybe :: Maybe (Maybe a) -> Maybe a+joinMaybe (Just (Just x)) = Just x+joinMaybe _ = Nothing

@@ -0,0 +1,122 @@+{-# LANGUAGE EmptyDataDecls #-}++module Data.MutMap+  ( -- * MutMap+    MutMap+  , mutEmpty+  , mutFromList+  , mutLookup+  , mutElems+  , mutKeys+  , mutAssocs+  , mutClone+  , mutMapM+  , mutMapM_+  , mutMapMaybeM+  , mutInsert+  , mutDelete+  , mutClear+  )+  where++import Data.Defined+import Data.MutMap.Internal+import Data.Text (Text)+import qualified Data.Text as T+import FFI+import Prelude++data MutMap a++-- Construction++mutEmpty :: Fay (MutMap a)+mutEmpty = ffi "{}"++mutFromList :: [(Text, a)] -> Fay (MutMap a)+mutFromList = mutFromListI . map (\(key, val) -> KeyValI (addSalt key) val)++mutFromListI :: [KeyValI a] -> Fay (MutMap a)+mutFromListI = ffi "function() { var r = {}; $.each(%1, function(ix, x) { r[x.slot1] = x.slot2; }); return r; }()"++-- Query++mutLookup :: Text -> MutMap a -> Fay (Maybe a)+mutLookup k m = return . fromDefined =<< mutLookupI (addSalt k) m++mutLookupI :: Salted -> MutMap a -> Fay (Defined a)+mutLookupI = ffi "%2[%1]"++mutElems :: MutMap a -> Fay [a]+mutElems = ffi "function() { var r = []; for (var k in %1) { r.push(%1[k]); } return r; }()"++mutKeys :: MutMap a -> Fay [Text]+mutKeys m = return . map unsalt =<< mutKeysI m++mutKeysI :: MutMap a -> Fay [Salted]+mutKeysI = ffi "function() { var r = []; for (var k in %1) { r.push(k); } return r; }()"++mutAssocs :: MutMap a -> Fay [(Text, a)]+mutAssocs m = return . map (\(KeyValI key val) -> (unsalt key, val)) =<< mutAssocsI m++mutAssocsI :: MutMap a -> Fay [KeyValI a]+mutAssocsI = ffi "function() { var r = []; for (var k in %1) { r.push({ instance : 'KeyValI', slot1 : k, slot2 : %1[k] }); } return r; }()"++mutClone :: MutMap a -> Fay (MutMap a)+mutClone = ffi "jQuery['extend']({}, %1)"++-- Note: Also clones.+mutMapM :: (a -> Fay b) -> MutMap a -> MutMap b+mutMapM = ffi "jQuery['map'](jQuery['extend']({}, %2), %1)"++mutMapM_ :: (a -> Fay ()) -> MutMap a -> Fay ()+mutMapM_ = ffi "jQuery['map'](%2, function(x) { %1(x); return x; })"++-- Note: Also clones.+mutMapMaybeM :: (a -> Fay (Maybe b)) -> MutMap a -> MutMap b+mutMapMaybeM f = mutMapMaybeMI $ \x -> f x >>= return . toDefined++mutMapMaybeMI :: (a -> Fay (Defined b)) -> MutMap a -> MutMap b+mutMapMaybeMI = ffi "jQuery['map']($['extend']({}, %2), %1)"++-- Mutation++mutInsert :: Text -> a -> MutMap a -> Fay ()+mutInsert = mutInsertI . addSalt++mutInsertI :: Salted -> a -> MutMap a -> Fay ()+mutInsertI = ffi "%3[%1] = %2"++mutDelete :: Text -> MutMap a -> Fay ()+mutDelete = mutDeleteI . addSalt++mutDeleteI :: Salted -> MutMap a -> Fay ()+mutDeleteI = ffi "delete %2[%1]"++mutClear :: MutMap a -> Fay ()+mutClear = ffi "function() { for (var k in %1) { delete %1[k]; } }()"++{- NOTE: I put out the effort to write these, but they are untested and ended+   up being unnecessary..++-- Reinserts everything into an object, in order to force serialization, using+-- the still-salted keys.  'Nothing' indicates a removal.+mutToObject :: (a -> Fay (Maybe (Automatic b))) -> MutMap a -> Fay Object+mutToObject f m = do+  obj <- objNew+  mutAssocsI m >>= mapM (\(KeyValI k v) -> do+      mv <- f v+      whenJust mv $ \v' -> objInsert (unsafeCoerce k) v' obj+    )+  return obj++objectToMut :: (Automatic b -> Fay (Maybe a)) -> Object -> Fay (MutMap a)+objectToMut f obj = do+  let obj' = unsafeCoerce obj+  m <- mutEmpty+  mutAssocsI obj' >>= mapM (\(KeyValI k v) -> do+      mv <- f v+      whenJust mv $ \v' -> when (checkSalted k) $ mutInsertI k v' m+    )+  return m+-}

@@ -0,0 +1,20 @@+{-# LANGUAGE EmptyDataDecls #-}++module Data.MutMap.Internal where++import Data.Text+import FFI+import Prelude++data KeyValI a = KeyValI Salted a++data Salted++addSalt :: Text -> Salted+addSalt = ffi "':' + %1"++unsalt :: Salted -> Text+unsalt = ffi "%1['substr'](1)"++checkSalted :: Salted -> Bool+checkSalted = ffi "%1['charAt'](0) == ':'"

@@ -0,0 +1,44 @@+-- | A trivial mutex.++module Data.Mutex where++import Prelude+import Data.Var++data Mutex = Mutex (Var Bool)++-- | Make a new unlocked mutex.+newMutex :: Fay Mutex+newMutex = do v <- newVar False+              return (Mutex v)++-- | If a mutex is free run the action, otherwise don't.+ifMutexFree :: Mutex -> Fay () -> Fay ()+ifMutexFree (Mutex var) action = do+  locked <- get var+  if locked then return () else action++-- | Wait until the mutex is free to do something.+whenMutexFree :: Mutex -> Fay () -> Fay ()+whenMutexFree (Mutex var) cont = do+  locked <- get var+  if locked+     then do _ <- withUnsubscriber+                    (subscribe var)+                    (\unsubscribe lockedNow ->+                       if lockedNow+                          then return ()+                          else do unsubscribe ()+                                  cont)+             return ()++     else cont++-- | Lock the given mutex until I'm done with it.+lockMutex :: Mutex -> (Fay () -> Fay a) -> Fay a+lockMutex (Mutex var) cont = do+  locked <- get var+  if locked+     then error "mutex is already locked"+     else do set var True+             cont (set var False)

@@ -0,0 +1,16 @@+-- | Nullable functions.++module Data.Nullable where++import FFI+import Prelude++-- | Convert from nullable to maybe.+fromNullable :: Nullable a -> Maybe a+fromNullable (Nullable x) = Just x+fromNullable Null = Nothing++-- | Convert from maybe to nullable.+toNullable :: Maybe a -> Nullable a+toNullable (Just x) = Nullable x+toNullable Nothing = Null

@@ -0,0 +1,13 @@+-- | Orderings++module Data.Ord where++-- |+-- > comparing p x y = compare (p x) (p y)+--+-- Useful combinator for use in conjunction with the @xxxBy@ family+-- of functions from "Data.List", for example:+--+-- >   ... sortBy (comparing fst) ...+comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering+comparing p x y = compare (p x) (p y)

@@ -0,0 +1,282 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NoRebindableSyntax #-}++-- | Compatible API with the `text' package.++module Data.Text+  ( Text+  -- * Creation and elimination+  , pack+  , unpack+  , fromString+  , empty+  -- * Conversions+  , showInt+  , toShortest+  -- * I/O+  , putStrLn+  -- * Breaking into many substrings+  , splitOn+  , stripSuffix+  -- * Basic interface+  , cons+  , snoc+  , append+  , (<>)+  , uncons+  , head+  , init+  , last+  , tail+  , null+  , length+  -- * Special folds+  , maximum+  , all+  , any+  , concatMap+  , concat+  , minimum+  -- * Case conversion+  , toLower+  , toUpper+  -- * Transformations+  , map+  , intercalate+  , intersperse+  , reverse+  -- * Predicates+  , isPrefixOf+  -- * Substrings+  , drop+  , take+  -- * Breaking into lines and words+  , unlines+  , lines+  ,+  ) where++import Data.Data+import FFI+import Data.Nullable (fromNullable)+import Prelude (Eq,String,Int,Bool,Char,Maybe,Double)++-- | A space efficient, packed, unboxed Unicode text type.+data Text+deriving instance Eq Text+deriving instance Data Text+deriving instance Typeable Text++-- | O(n) The intercalate function takes a Text and a list of Texts and+-- concatenates the list after interspersing the first argument+-- between each element of the list.+intercalate :: Text -> [Text] -> Text+intercalate = ffi "%2.join(%1)"++-- | Convert from a string to text.+fromString :: String -> Text+fromString = ffi "%1"++-- | O(n) Adds a character to the end of a Text. This copies the+-- entire array in the process, unless fused. Subject to+-- fusion. Performs replacement on invalid scalar values.+snoc :: Text -> Char -> Text+snoc = ffi "%1 + %2"++-- | O(n) Adds a character to the front of a Text. This function is+-- more costly than its List counterpart because it requires copying a+-- new array. Subject to fusion. Performs replacement on invalid+-- scalar values.+cons :: Char -> Text -> Text+cons = ffi "%1 + %2"++-- | O(n) Convert a String into a Text. Subject to fusion. Performs+-- replacement on invalid scalar values.+pack :: Text -> String+pack = ffi "%1"++-- | O(n) Convert a Text into a String. Subject to fusion.+unpack :: Text -> String+unpack = ffi "%1"++-- | O(n) Appends one Text to the other by copying both of them into a+-- new Text. Subject to fusion.+append :: Text -> Text -> Text+append = ffi "%1 + %2"++-- | Append two texts.+(<>) :: Text -> Text -> Text+(<>) = ffi "%1 + %2"++-- | O(n) Returns the number of characters in a Text. Subject to+-- fusion.+length :: Text -> Int+length = ffi "%1.length"++-- | O(1) Tests whether a Text is empty or not. Subject to fusion.+null :: Text -> Bool+null = ffi "%1.length == 0"++-- | O(n) take n, applied to a Text, returns the prefix of the Text of+-- length n, or the Text itself if n is greater than the length of the+-- Text. Subject to fusion.+take :: Int -> Text -> Text+take = ffi "%2.substring(0,%1)"++-- | O(n) drop n, applied to a Text, returns the suffix of the Text+-- after the first n characters, or the empty Text if n is greater+-- than the length of the Text. Subject to fusion.+drop :: Int -> Text -> Text+drop = ffi "%2.substring(%1)"++-- | O(1) The empty Text.++-- Basic interface+empty :: Text+empty = ffi "\"\""++-- | O(n) Breaks a Text up into a list of Texts at newline Chars. The+-- resulting strings do not contain newlines.+lines :: Text -> [Text]+lines = ffi "%1.split('\\n')"++-- | O(n) Joins lines, after appending a terminating newline to each.+unlines :: [Text] -> Text+unlines = ffi "%1.join('\\n')"++-- | O(n) The isPrefixOf function takes two Texts and returns True iff+-- the first is a prefix of the second. Subject to fusion.+-- http://docs.closure-library.googlecode.com/git/closure_goog_string_string.js.source.html+isPrefixOf :: Text -> Text -> Bool+isPrefixOf = ffi "%2.lastIndexOf(%1, 0) == 0"++-- | O(n) The intersperse function takes a character and places it+-- between the characters of a Text.  Subject to fusion. Performs+-- replacement on invalid scalar values.+intersperse :: Char -> Text -> Text+intersperse = ffi "%2.split('').join(%1)"++-- | O(n) Reverse the characters of a string. Subject to fusion.+reverse :: Text -> Text+reverse = ffi "%1.split('').reverse().join('')"++-- | O(n) Return the prefix of the second string if its suffix matches+-- the entire first string.+stripSuffix :: Text -- ^ Suffix.+                -> Text -- ^ Text.+                -> Maybe Text+stripSuffix prefix text =+  fromNullable (extract prefix text)+  where extract :: Text -> Text -> Nullable Text+        extract =+          ffi "(function(suffix,text){ return text.substring(text.length - suffix.length) == suffix? text.substring(0,text.length - suffix.length) : null; })(%1,%2)"++-- | O(m+n) Break a Text into pieces separated by the first Text+-- argument, consuming the delimiter. An empty delimiter is+-- invalid, and will cause an error to be raised.+splitOn :: Char -> Text -> [Text]+splitOn = ffi "%2.split(%1)"++-- |+putStrLn :: Text -> Fay ()+putStrLn = ffi "console.log('%%s',%1)"++-- |+toShortest :: Double -> Text+toShortest = ffi "%1.toString()"++-- |+showInt :: Int -> Text+showInt = ffi "%1.toString()"++-- | O(1) Returns the first character and rest of a Text, or Nothing+-- if empty. Subject to fusion.+uncons :: Text -> Maybe (Char, Text)+uncons = ffi "%1[0] ? { instance: 'Just', slot1 : [%1[0],%1.slice(1)] } : { instance : 'Nothing' }"++-- | O(1) Returns the first character of a Text, which must be+-- non-empty. Subject to fusion.+head :: Text -> Char+head = ffi "%1[0] || (function () {throw new Error('Data.Text.head: empty Text'); }())"++-- | O(1) Returns the last character of a Text, which must be+-- non-empty. Subject to fusion.+last :: Text -> Char+last = ffi "%1.length ? %1[%1.length-1] : (function() { throw new Error('Data.Text.last: empty Text') })()"++-- | O(1) Returns all characters after the head of a Text, which must+-- be non-empty. Subject to fusion.+tail :: Text -> Text+tail = ffi "%1.length ? %1.slice(1) : (function () { throw new Error('Data.Text.tail: empty Text') })()"++-- | O(1) Returns all but the last character of a Text, which must be+-- non-empty. Subject to fusion.+init :: Text -> Text+init = ffi "%1.length ? %1.slice(0,-1) : (function () { throw new Error('Data.Text.init: empty Text') })()"++-- | O(n) map f t is the Text obtained by applying f to each element+-- of t. Subject to fusion. Performs replacement on invalid scalar+-- values.+map :: (Char -> Char) -> Text -> Text+map = ffi "[].map.call(%2, %1).join('')"++-- | O(n) Convert a string to lower case, using simple case+-- conversion. The result string may be longer than the input+-- string. For instance, "İ" (Latin capital letter I with dot above,+-- U+0130) maps to the sequence "i" (Latin small letter i, U+0069)+-- followed by " ̇" (combining dot above, U+0307).+toLower :: Text -> Text+toLower = ffi "%1.toLowerCase()"++-- | O(n) Convert a string to upper case, using simple case+-- conversion. The result string may be longer than the input+-- string. For instance, the German "ß" (eszett, U+00DF) maps to the+-- two-letter sequence "SS".+toUpper :: Text -> Text+toUpper = ffi "%1.toUpperCase()"++-- | O(n) Concatenate a list of Texts.+concat :: [Text] -> Text+concat = ffi "%1.join('')"++-- | O(n) Map a function over a Text that results in a Text, and+-- concatenate the results.+concatMap :: (Char -> Text) -> Text -> Text+concatMap = ffi "[].map.call(%2, %1).join('')"++-- | O(n) any p t determines whether any character in the Text t+-- satisifes the predicate p. Subject to fusion.+any :: (Char -> Bool) -> Text -> Bool+any = ffi "[].filter.call(%2, %1).length > 0"++-- | O(n) all p t determines whether all characters in the Text t+-- satisify the predicate p. Subject to fusion.+all :: (Char -> Bool) -> Text -> Bool+all = ffi "[].filter.call(%2, %1).length == %1.length"++-- | O(n) maximum returns the maximum value from a Text, which must be+-- non-empty. Subject to fusion.+maximum :: Text -> Char+maximum = ffi "(function (s) { \+  \   if (s === '') { throw new Error('Data.Text.maximum: empty string'); } \+  \   var max = s[0]; \+  \   for (var i = 1; i < s.length; s++) { \+  \     if (s[i] > max) { max = s[i]; } \+  \   } \+  \   return max; \+  \ })(%1)"++-- | O(n) minimum returns the minimum value from a Text, which must be+-- non-empty. Subject to fusion.+minimum :: Text -> Char+minimum = ffi "(function (s) { \+  \   if (s === '') { throw new Error('Data.Text.maximum: empty string'); } \+  \   var min = s[0]; \+  \   for (var i = 1; i < s.length; s++) { \+  \     if (s[i] < min) { min = s[i]; } \+  \   } \+  \   return min; \+  \ })(%1)"

@@ -0,0 +1,68 @@+{-# OPTIONS -fno-warn-missing-methods #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyDataDecls #-}++-- | A limited subset of the time package.++module Data.Time+  (-- * Compatible with the time package+  getCurrentTime+  ,fromGregorian+  ,UTCTime+  ,Day+  ,utctDay+  -- * Incompatible Fay-specific helpers+  ,showTime+  ,showDay)+  where++import Data.Data+import Data.Text+import FFI+import Prelude (Show,Eq,Ord,Int)++-- | Date representation (internally represented as milliseconds from Epoch).+data UTCTime+    deriving (Typeable)++-- We provide no methods, this is just to satisfy type-safety. No+-- methods work in Fay anyway.+instance Data UTCTime+instance Show UTCTime+instance Eq UTCTime+instance Ord UTCTime++-- | Day representation (internally represented as milliseconds from Epoch).+data Day+    deriving (Typeable)+-- We provide no methods, this is just to satisfy type-safety. No+-- methods work in Fay anyway.+instance Data Day+instance Show Day+instance Eq Day+instance Ord Day++-- | Get the current time.+getCurrentTime :: Fay UTCTime+getCurrentTime = ffi "(new Date()).getTime()"++-- | Convert from proleptic Gregorian calendar. First argument is+-- year, second month number (1-12), third day (1-31).+fromGregorian :: Int -- ^ Year.+              -> Int -- ^ Month.+              -> Int -- ^ Day.+              -> Day+fromGregorian = ffi "Date.UTC(%1,%2-1,%3)"++-- | Extract the day from the time.+utctDay :: UTCTime -> Day+utctDay = ffi "%1"++-- | Show a time. Meant for debugging purposes, not production presentation.+showTime :: UTCTime -> Text+showTime = ffi "new Date(%1).toString()"++-- | Show a day. Meant for debugging purposes, not production presentation.+showDay :: Day -> Text+showDay =+  ffi "date.getUTCFullYear() + ' ' + showMonth(date) + ' ' + (date.getUTCDate() + 1)"

@@ -0,0 +1,302 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}++module Data.Var+  (+  -- * Different types of variables+    Sig+  , newSig+  , Ref+  , newRef+  , Var+  , newVar++  -- * Generic operations+  , Settable+  , set+  , Gettable+  , get+  , modify+  , modifyWith+  , Subscribable+  , subscribe+  , withUnsubscriber++  -- * Specific operations+  , subscribeWithOld+  , subscribeChange+  , subscribeAndRead+  , subscribeChangeAndRead+  , subscribeExclusive+  , subscribeAndReadExclusive+  , mapVar+  , mergeVars+  , mergeVars'+  , tupleVars+  , tupleVars'+  , waitForN+  , waitFor+  , oneShot+  , holdSig++  ) where++import Data.Maybe+import FFI+import Prelude++-- | A subscribable signal.  Can have handlers subscribed to them, but doesn't+--   store a value.+data Sig a++-- | Make a new signal.+newSig :: Fay (Sig a)+newSig = ffi "new Fay$$Sig()"++-- | A mutable reference, with no subscribers.+data Ref a++-- | Make a new mutable reference.+newRef :: a -> Fay (Ref a)+newRef = ffi "new Fay$$Ref2(%1)"++-- | A reactive variable.  Stores a value, and can have handlers subscribed to+--   changes.+data Var a++-- | Make a new reactive variable.+newVar :: a -> Fay (Var a)+newVar = ffi "new Fay$$Var(%1)"+++-- | All of the variable types can be set to a value.+class Settable v+instance Settable (Ref a)+instance Settable (Sig a)+instance Settable (Var a)++-- | Write to the value (if any), and call subscribers (if any).+set :: Settable (v a) => v a -> a -> Fay ()+set = ffi "Fay$$setValue(Fay$$_(%1), %2, Fay$$_)"+++-- | 'Ref' and 'Var' store their last set value.+class Gettable v+instance Gettable (Ref a)+instance Gettable (Var a)++-- | Get the value of a 'Ref' or 'Var'.+get :: Gettable (v a) => v a -> Fay a+get = ffi "Fay$$_(%1).val"++-- | Modifies the current value with a pure function.+modify :: (Settable (v a), Gettable (v a)) => v a -> (a -> a) -> Fay ()+modify v f = get v >>= set v . f++-- | Runs a 'Fay' action on the current value, and updates with the result.+modifyWith :: (Settable (v a), Gettable (v a)) => v a -> (a -> Fay a) -> Fay ()+modifyWith v f = get v >>= f >>= set v++-- | 'Sig' and 'Var' have lists of subscribers that are notified when 'set' is+--   used.+class Settable v => Subscribable v+instance Subscribable (Sig a)+instance Subscribable (Var a)++-- | Subscribe to the value of a 'Sig' or 'Var'.+--+--   The result is an unsubscribe function.+subscribe :: Subscribable (v a) => v a -> Ptr (a -> Fay void) -> Fay (() -> Fay ())+subscribe = ffi "Fay$$subscribe(Fay$$_(%1), Fay$$_(%2))"++-- | Run the same subscribing action but provide an additional+-- unsubscribe parameter to the handler.+withUnsubscriber :: ((a -> Fay ()) -> Fay (() -> Fay ()))+                 -> (((() -> Fay ()) -> a -> Fay ()) -> Fay (() -> Fay ()))+withUnsubscriber f = \g -> do+  unsubscriber <- newRef Nothing+  unsubscribe <- f $ \v -> do munsubscriber <- get unsubscriber+                              whenJust munsubscriber $ \unsubscribe -> g unsubscribe v+  set unsubscriber (Just unsubscribe)+  return unsubscribe++-- | Subscribe to a 'Var', along with the previous value.+--+--   The result is an unsubscribe function.+subscribeWithOld :: Var a -> (a -> a -> Fay ()) -> Fay (() -> Fay ())+subscribeWithOld v f = do+  o <- get v >>= newRef+  subscribe v $ \x' -> do+    x <- get o+    set o x'+    f x x'++-- | Subscribe to a 'Var', but only call handler when it actually changes.+--+--   The result is an unsubscribe function.+subscribeChange :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())+subscribeChange v f = subscribeWithOld v $ \x x' -> when (x /= x') $ f x'++-- | Subscribe to a 'Var', and call the function on the current value.+--+--   The result is an unsubscribe function.+subscribeAndRead :: Var a -> (a -> Fay void) -> Fay (() -> Fay ())+subscribeAndRead v f = do+  x <- get v+  f x+  subscribe v f++-- | Subscribe to a 'Var', but only call handler when it actually changes, and+--   also initially on registration.+--+--   The result is an unsubscribe function.+subscribeChangeAndRead :: Eq a => Var a -> (a -> Fay ()) -> Fay (() -> Fay ())+subscribeChangeAndRead v f = do+  x <- get v+  f x+  subscribeChange v f+++-- | Given a change handler, returns a function that can be used to set a+--   subscribable without invoking the handler.  This can be useful in+--   situations where the handler for a 'Var' causes an event which otherwise+--   ought to set the value of the 'Var'.  An example of this is interfacing+--   with HTML input field change events.+--+--   The 'snd' part of the result is an unsubscribe function.+subscribeExclusive :: Subscribable (v a) => v a -> (a -> Fay ()) -> Fay (a -> Fay (), () -> Fay ())+subscribeExclusive v onChange = do+  bracket <- getBracket+  unsubscribe <- subscribe v $ bracket . onChange+  return (\x -> bracket $ set v x, unsubscribe)++-- | Given a change handler, returns a function that can be used to set a var+--   without invoking the handler. The handler is called with the initial+--   value. This can be useful in situations where the handler for a 'Var'+--   causes an event which otherwise ought to set the value of the 'Var'.  An+--   example of this is interfacing with HTML input field change events.+--+--   The 'snd' part of the result is an unsubscribe function.+subscribeAndReadExclusive :: Var a -> (a -> Fay ()) -> Fay (a -> Fay (), () -> Fay ())+subscribeAndReadExclusive v onChange = do+  bracket <- getBracket+  unsubscribe <- subscribeAndRead v $ bracket . onChange+  return (\x -> bracket $ set v x, unsubscribe)++-- Utility used for 'subscribeExclusive', 'subscribeAndReadExclusive', and+-- 'mergeVars'.+getBracket :: Fay (Fay () -> Fay ())+getBracket = do+  rhandle <- newRef True+  return $ \f -> do+    handle <- get rhandle+    when handle $ do+      set rhandle False+      f+      set rhandle True++--TODO: mapVar variant that's bidirectional?+--TODO: return unsubscribe?++-- | Creates a 'Var' that updates whenever the source var is changed, applying+--   the provided function to compute the new value.+mapVar :: (a -> b) -> Var a -> Fay (Var b)+mapVar f v = do+  x <- get v+  r <- newVar (f x)+  _ <- subscribe v $ \x' -> set r $ f x'+  return r++-- | Creates a 'Var' that updates whenever one of its source vars are changed.+--   If the 2nd argument is a 'Just' value, then its used to set the source+--   vars when the variable is changed. Setting using a merged var is+--   sometimes preferred because both values are set before the subscribers+--   are called.+--+--   The 'snd' part of the result is an unsubscribe function.+mergeVars :: (a -> b -> c) -> Maybe (c -> (a, b)) -> Var a -> Var b+          -> Fay (Var c, Fay ())+mergeVars f mg va vb = do+  bracket <- getBracket+  a0 <- get va+  b0 <- get vb+  vc <- newVar (f a0 b0)+  unsubscribeA <- subscribe va $ \a -> bracket $ do+    b <- get vb+    set vc (f a b)+  unsubscribeB <- subscribe vb $ \b -> bracket $ do+    a <- get va+    set vc (f a b)+  unsubscribe <- case mg of+    Nothing -> return $ unsubscribeA () >> unsubscribeB ()+    Just g -> do+      unsubscribeC <- subscribe vc $ \c -> bracket $ case g c of+        (a, b) -> do+          -- Set variables before broadcast.+          setInternal va a+          setInternal vb b+          broadcastInternal va a+          broadcastInternal vb b+      return $ unsubscribeA () >> unsubscribeB () >> unsubscribeC ()+  return (vc, unsubscribe)++setInternal :: Var a -> a -> Fay ()+setInternal = ffi "function() { Fay$$_(%1).val = %2; }()"++broadcastInternal :: Var a -> a -> Fay ()+broadcastInternal = ffi "Fay$$broadcastInternal(Fay$$_(%1), %2, Fay$$_)"++-- | Like 'mergeVars', but discards the unsubscribe function.+mergeVars' :: (a -> b -> c) -> Maybe (c -> (a, b)) -> Var a -> Var b+           -> Fay (Var c)+mergeVars' f mg va vb = do+  result <- mergeVars f mg va vb+  case result of+    (v, _) -> return v++-- | Creates a 'Var' that updates whenever one of its source vars are changed.+--   It can also be used to set both source vars at once.+--+--   See 'mergeVars' for more information.  Note that when using nested tuples,+--   if you want all of the values to be set before broadcast, then they should+--   nest to the left.+tupleVars :: Var a -> Var b -> Fay (Var (a, b), Fay ())+tupleVars = mergeVars (\x y -> (x, y)) (Just id)++-- | Like 'tupleVars', but discards the unsubscribe function.+tupleVars' :: Var a -> Var b -> Fay (Var (a, b))+tupleVars' va vb = do+  result <- tupleVars va vb+  case result of+    (v, _) -> return v++-- | Wait for n signals on the given signaller.+waitForN :: Int -> Fay (Fay void -> Fay (),Sig ())+waitForN n = do+  sig <- newSig+  count <- newVar (0 :: Int)+  _ <- subscribe sig (const (modify count (+1)))+  return (\m -> subscribeAndRead count (\i -> when (i == n) (m >> return ())) >> return (),sig)++-- | Wait for the given predicate to be satisfied on the var and then+-- unsubscribe.+waitFor :: Var a -> (a -> Bool) -> (a -> Fay ()) -> Fay ()+waitFor v p f = do+  _ <- withUnsubscriber (subscribeAndRead v)+    $ \unsubscribe x -> when (p x) $ unsubscribe () >> f x+  return ()++-- | Make a one-shot variable subscription that immediately+-- unsubscribes after the event has triggered.+oneShot :: Subscribable (v a) => v a -> (a -> Fay ()) -> Fay ()+oneShot v f = do+  _ <- withUnsubscriber (subscribe v) $ \unsubscribe x -> unsubscribe () >> f x+  return ()++-- | Turn a sig into a var, by storing the last reported value.+holdSig :: a -> Sig a -> Fay (Var a)+holdSig initial sig = do+  v <- newVar initial+  void $ subscribe sig $ set v+  return v

@@ -0,0 +1,9 @@+-- | Unsafe running of Fay actions in pure code.++module Fay.Unsafe where++import FFI++-- | Run a Fay action as a pure value.+unsafePerformFay :: Fay a -> a+unsafePerformFay = ffi "%1()"

@@ -0,0 +1,8 @@+-- | Unsafe coerce.++module Unsafe.Coerce where++import FFI++unsafeCoerce :: a -> b+unsafeCoerce = ffi "%1"