purescript 0.7.2.1 → 0.7.3.0

raw patch · 43 files changed

+484/−1901 lines, 43 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• examples/failing/InfiniteKind.purs +5/−0
• examples/failing/InfiniteType.purs +5/−0
• examples/failing/OrphanInstance.purs +12/−0
• psc/Main.hs +15/−3
• psci/PSCi.hs +1/−1
• psci/Types.hs +2/−2
• psci/tests/data/Sample.purs +0/−0
• purescript.cabal +6/−3
• src/Language/PureScript/AST/Declarations.hs +21/−1
• src/Language/PureScript/AST/Traversals.hs +7/−6
• src/Language/PureScript/Constants.hs +14/−0
• src/Language/PureScript/Errors.hs +29/−9
• src/Language/PureScript/Make.hs +36/−30
• src/Language/PureScript/Parser/Declarations.hs +16/−1
• src/Language/PureScript/Parser/JS.hs +3/−3
• src/Language/PureScript/Parser/Lexer.hs +1/−0
• src/Language/PureScript/Pretty/JS.hs +1/−0
• src/Language/PureScript/Publish/ErrorsWarnings.hs +2/−2
• src/Language/PureScript/Sugar.hs +2/−0
• src/Language/PureScript/Sugar/CaseDeclarations.hs +1/−1
• src/Language/PureScript/Sugar/TypeClasses.hs +2/−1
• src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +229/−0
• src/Language/PureScript/TypeChecker.hs +16/−2
• src/Language/PureScript/TypeChecker/Types.hs +1/−0
• tests/Main.hs +17/−48
• tests/support/bower.json +11/−0
• tests/support/flattened/Control-Monad-Eff-Class.purs +0/−24
• tests/support/flattened/Control-Monad-Eff-Console.js +0/−18
• tests/support/flattened/Control-Monad-Eff-Console.purs +0/−18
• tests/support/flattened/Control-Monad-Eff-Unsafe.js +0/−8
• tests/support/flattened/Control-Monad-Eff-Unsafe.purs +0/−10
• tests/support/flattened/Control-Monad-Eff.js +0/−62
• tests/support/flattened/Control-Monad-Eff.purs +0/−67
• tests/support/flattened/Control-Monad-ST.js +0/−38
• tests/support/flattened/Control-Monad-ST.purs +0/−42
• tests/support/flattened/Data-Function.js +0/−233
• tests/support/flattened/Data-Function.purs +0/−113
• tests/support/flattened/Prelude.js +0/−222
• tests/support/flattened/Prelude.purs +0/−860
• tests/support/flattened/Test-Assert.js +0/−27
• tests/support/flattened/Test-Assert.purs +0/−46
• tests/support/package.json +7/−0
• tests/support/setup.js +22/−0

@@ -0,0 +1,5 @@+-- @shouldFailWith InfiniteKind ++module Main where++data F a = F (a a)

@@ -0,0 +1,5 @@+-- @shouldFailWith InfiniteType ++module Main where++f a = a a

@@ -0,0 +1,12 @@+-- @shouldFailWith OrphanInstance+module Class where++  class C a where+    op :: a -> a++module Test where++  import Class++  instance cBoolean :: C Boolean where+    op a = a

@@ -52,12 +52,12 @@  compile :: PSCMakeOptions -> IO () compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do-  input <- concat <$> mapM glob inputGlob+  input <- globWarningOnMisses warnFileTypeNotFound inputGlob   when (null input) $ do     hPutStrLn stderr "psc: No input files."     exitFailure   moduleFiles <- readInput (InputOptions input)-  inputForeign <- concat <$> mapM glob inputForeignGlob+  inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob   foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)   case runWriterT (parseInputs moduleFiles foreignFiles) of     Left errs -> do@@ -78,13 +78,25 @@             hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')           exitSuccess +warnFileTypeNotFound :: String -> IO ()+warnFileTypeNotFound = hPutStrLn stderr . ((++) "psc: No files found using pattern: ")++globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]+globWarningOnMisses warn = concatMapM globWithWarning+  where+  globWithWarning pattern = do+    paths <- glob pattern+    when (null paths) $ warn pattern+    return paths+  concatMapM f = liftM concat . mapM f+ readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)] readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile  parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)             => [(Either P.RebuildPolicy FilePath, String)]             -> [(FilePath, P.ForeignJS)]-            -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))+            -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath) parseInputs modules foreigns =   (,) <$> P.parseModulesFromFiles (either (const "") id) modules       <*> P.parseForeignModulesFromFiles foreigns

@@ -251,7 +251,7 @@ -- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the -- options and ignores the warning messages. runMake :: P.Make a -> IO (Either P.MultipleErrors a)-runMake mk = fmap (fmap fst) $ P.runMake (P.Options False False Nothing False False False Nothing) mk+runMake mk = fmap (fmap fst) $ P.runMake P.defaultOptions mk  makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a makeIO f io = do

@@ -35,7 +35,7 @@   { psciImportedFilenames   :: [FilePath]   , psciImportedModules     :: [ImportedModule]   , psciLoadedModules       :: [(Either P.RebuildPolicy FilePath, P.Module)]-  , psciForeignFiles        :: M.Map P.ModuleName (FilePath, P.ForeignJS)+  , psciForeignFiles        :: M.Map P.ModuleName FilePath   , psciLetBindings         :: [P.Declaration]   , psciNodeFlags           :: [String]   }@@ -91,7 +91,7 @@ -- | -- Updates the state to have more let bindings. ---updateForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> PSCiState -> PSCiState+updateForeignFiles :: M.Map P.ModuleName FilePath -> PSCiState -> PSCiState updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }  -- |

@@ -1,5 +1,5 @@ name: purescript-version: 0.7.2.1+version: 0.7.3.0 cabal-version: >=1.8 build-type: Simple license: MIT@@ -20,8 +20,10 @@  extra-source-files: examples/passing/*.purs                   , examples/failing/*.purs-                  , tests/support/flattened/*.purs-                  , tests/support/flattened/*.js+                  , tests/support/setup.js+                  , tests/support/package.json+                  , tests/support/bower.json+                  , psci/tests/data/Sample.purs  source-repository head     type: git@@ -120,6 +122,7 @@                      Language.PureScript.Sugar.ObjectWildcards                      Language.PureScript.Sugar.Operators                      Language.PureScript.Sugar.TypeClasses+                     Language.PureScript.Sugar.TypeClasses.Deriving                       Language.PureScript.Sugar.TypeDeclarations                      Language.PureScript.Traversals                      Language.PureScript.TypeChecker

@@ -19,6 +19,10 @@ import qualified Data.Data as D import qualified Data.Map as M +import Control.Monad.Identity++import Control.Applicative+ import Language.PureScript.AST.Binders import Language.PureScript.AST.Operators import Language.PureScript.AST.SourcePos@@ -154,12 +158,28 @@   -- A type instance declaration (name, dependencies, class name, instance types, member   -- declarations)   ---  | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] [Declaration]+  | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] TypeInstanceBody   -- |   -- A declaration with source position information   --   | PositionedDeclaration SourceSpan [Comment] Declaration   deriving (Show, D.Data, D.Typeable)++-- | The members of a type class instance declaration+data TypeInstanceBody+  -- | This is a derived instance+  = DerivedInstance+  -- | This is a regular (explicit) instance+  | ExplicitInstance [Declaration]+  deriving (Show, D.Data, D.Typeable)+ +mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody+mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)+ +-- | A traversal for TypeInstanceBody+traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody+traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance+traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds  -- | -- Test if a declaration is a value declaration

@@ -16,6 +16,7 @@  import Data.Monoid (Monoid(..), mconcat) import Data.Maybe (mapMaybe)+import Data.Traversable (traverse)  import Control.Applicative import Control.Monad@@ -37,7 +38,7 @@   f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))   f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))   f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))-  f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))+  f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))   f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))   f' other = f other @@ -95,7 +96,7 @@   f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val   f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds   f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds-  f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f' <=< f) ds+  f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds   f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')   f' other = f other @@ -147,7 +148,7 @@   f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> mapM h' bs <*> eitherM (mapM (pairM g' g')) g' val) >>= f   f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f   f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f-  f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> mapM f' ds) >>= f+  f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM f') ds) >>= f   f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f   f' other = f other @@ -202,7 +203,7 @@   f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)   f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)   f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)-  f' d@(TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)+  f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)   f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1   f' d = f d @@ -266,7 +267,7 @@   f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)   f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)   f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)-  f' s (TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)+  f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)   f' s (PositionedDeclaration _ _ d1) = f'' s d1   f' _ _ = r0 @@ -335,7 +336,7 @@   f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val   f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds   f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds-  f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f'' s) ds+  f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM (f'' s)) ds   f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1   f' _ other = return other 

@@ -238,6 +238,20 @@ semigroupoidArr :: String semigroupoidArr = "semigroupoidArr" +-- Generic Deriving++generic :: String+generic = "Generic"++toSpine :: String+toSpine = "toSpine"++fromSpine :: String+fromSpine = "fromSpine"++toSignature :: String+toSignature = "toSignature"+ -- Main module  main :: String

@@ -1,8 +1,8 @@ ----------------------------------------------------------------------------- -- -- Module      :  Language.PureScript.Error--- Copyright   :  (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors--- License     :  MIT+-- Copyright   :  (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess+-- License     :  MIT (http://opensource.org/licenses/MIT) -- -- Maintainer  :  Phil Freeman <paf31@cantab.net> -- Stability   :  experimental@@ -102,6 +102,8 @@   | ConstrainedTypeUnified Type Type   | OverlappingInstances (Qualified ProperName) [Type] [DictionaryValue]   | NoInstanceFound (Qualified ProperName) [Type]+  | CannotDerive (Qualified ProperName) [Type]+  | CannotFindDerivingType ProperName   | DuplicateLabel String (Maybe Expr)   | DuplicateValueDeclaration Ident   | ArgListLengthsDiffer Ident@@ -115,6 +117,7 @@   | PropertyIsMissing String Type   | CannotApplyFunction Type Expr   | TypeSynonymInstance+  | OrphanInstance Ident (Qualified ProperName) [Type]   | InvalidNewtype   | InvalidInstanceHead Type   | TransitiveExportError DeclarationRef [DeclarationRef]@@ -213,6 +216,8 @@   (ConstrainedTypeUnified _ _)  -> "ConstrainedTypeUnified"   (OverlappingInstances _ _ _)  -> "OverlappingInstances"   (NoInstanceFound _ _)         -> "NoInstanceFound"+  (CannotDerive _ _)            -> "CannotDerive"+  (CannotFindDerivingType _)    -> "CannotFindDerivingType"   (DuplicateLabel _ _)          -> "DuplicateLabel"   (DuplicateValueDeclaration _) -> "DuplicateValueDeclaration"   (ArgListLengthsDiffer _)      -> "ArgListLengthsDiffer"@@ -226,6 +231,7 @@   (PropertyIsMissing _ _)       -> "PropertyIsMissing"   (CannotApplyFunction _ _)     -> "CannotApplyFunction"   TypeSynonymInstance           -> "TypeSynonymInstance"+  (OrphanInstance _ _ _)        -> "OrphanInstance"   InvalidNewtype                -> "InvalidNewtype"   (InvalidInstanceHead _)       -> "InvalidInstanceHead"   (TransitiveExportError _ _)   -> "TransitiveExportError"@@ -242,10 +248,10 @@   { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)  instance UnificationError Type MultipleErrors where-  occursCheckFailed = occursCheckFailed+  occursCheckFailed t = MultipleErrors [occursCheckFailed t]  instance UnificationError Kind MultipleErrors where-  occursCheckFailed = occursCheckFailed+  occursCheckFailed k = MultipleErrors [occursCheckFailed k]  -- | Check whether a collection of errors is empty or not. nonEmpty :: MultipleErrors -> Bool@@ -507,6 +513,10 @@             ]     goSimple (NoInstanceFound nm ts) =       line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)+    goSimple (CannotDerive nm ts) =+      line $ "Cannot derive " ++ show nm ++ " instance for " ++ unwords (map prettyPrintTypeAtom ts)+    goSimple (CannotFindDerivingType nm) =+      line $ "Cannot derive instance, because the type declaration for " ++ show nm ++ " could not be found."     goSimple (DuplicateLabel l expr) =       paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]                        <> foldMap (\expr' -> [ line "Relevant expression: "@@ -545,6 +555,8 @@             ]     goSimple TypeSynonymInstance =       line "Type synonym instances are disallowed"+    goSimple (OrphanInstance nm cnm ts) =+      line $ "Instance " ++ show nm ++ " for " ++ show cnm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ " is an orphan instance"     goSimple InvalidNewtype =       line "Newtypes must define a single constructor with a single argument"     goSimple (InvalidInstanceHead ty) =@@ -747,24 +759,32 @@ -- Pretty print multiple errors -- prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String-prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error found:" "Multiple errors found:" full+prettyPrintMultipleErrors full = renderBox . prettyPrintMultipleErrorsBox full  -- | -- Pretty print multiple warnings -- prettyPrintMultipleWarnings :: Bool -> MultipleErrors ->  String-prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning found:" "Multiple warnings found:" full+prettyPrintMultipleWarnings full = renderBox . prettyPrintMultipleWarningsBox full -prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State UnknownMap String+-- | Pretty print warnings as a Box+prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box+prettyPrintMultipleWarningsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning found:" "Multiple warnings found:" full++-- | Pretty print errors as a Box+prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box+prettyPrintMultipleErrorsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error found:" "Multiple errors found:" full++prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State UnknownMap Box.Box prettyPrintMultipleErrorsWith level intro _ full  (MultipleErrors [e]) = do   result <- prettyPrintSingleError full level e-  return $ renderBox $+  return $     Box.vcat Box.left [ Box.text intro                       , result                       ] prettyPrintMultipleErrorsWith level _ intro full  (MultipleErrors es) = do   result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full level-  return $ renderBox $+  return $     Box.vcat Box.left [ Box.text intro                       , Box.vsep 1 Box.left result                       ]

@@ -24,8 +24,8 @@   (   -- * Make API     RebuildPolicy(..)+  , ProgressMessage(..), renderProgressMessage   , MakeActions(..)-  , SupplyVar()   , Externs()   , make   @@ -43,12 +43,12 @@ import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.Supply-import Control.Monad.Supply.Class (fresh)  import Data.Function (on) import Data.List (sortBy, groupBy) import Data.Maybe (fromMaybe) import Data.Time.Clock+import Data.Foldable (for_) import Data.Traversable (traverse) import Data.Version (showVersion) import qualified Data.Map as M@@ -59,7 +59,6 @@ import System.FilePath ((</>), takeDirectory) import System.IO.Error (tryIOError) - import Language.PureScript.AST import Language.PureScript.CodeGen.Externs (moduleToPs) import Language.PureScript.Environment@@ -79,9 +78,23 @@ import qualified Language.PureScript.CoreFn as CF import qualified Paths_purescript as Paths --- |--- Actions that require implementations when running in "make" mode.+-- | Progress messages from the make process+data ProgressMessage+  = CompilingModule ModuleName+  deriving (Show, Eq, Ord)++-- | Render a progress message+renderProgressMessage :: ProgressMessage -> String+renderProgressMessage (CompilingModule mn) = "Compiling " ++ runModuleName mn++-- | Actions that require implementations when running in "make" mode. --+-- This type exists to make two things abstract:+--+-- * The particular backend being used (Javascript, C++11, etc.)+-- +-- * The details of how files are read/written etc.+-- data MakeActions m = MakeActions {   -- |   -- Get the timestamp for the input file(s) for a module. If there are multiple@@ -102,11 +115,11 @@   -- |   -- Run the code generator for the module and write any required output files.   ---  , codegen :: CF.Module CF.Ann -> Environment -> SupplyVar -> Externs -> m ()+  , codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT m ()   -- |   -- Respond to a progress update.   ---  , progress :: String -> m ()+  , progress :: ProgressMessage -> m ()   }  -- |@@ -115,11 +128,6 @@ type Externs = String  -- |--- A value to be used in the Supply monad.----type SupplyVar = Integer---- | -- Determines when to rebuild a module -- data RebuildPolicy@@ -140,7 +148,6 @@      -> m Environment make MakeActions{..} ms = do   (sorted, graph) <- sortModules $ map importPrim ms-  mapM_ lint sorted   toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do     inputTimestamp <- getInputTimestamp moduleName'     outputTimestamp <- getOutputTimestamp moduleName'@@ -150,6 +157,7 @@       _ -> S.insert moduleName' s) S.empty sorted    marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted+  for_ marked $ \(willRebuild, m) -> when willRebuild (lint m)   (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)   evalSupplyT nextVar $ go initEnvironment desugared   where@@ -160,7 +168,7 @@     (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m     go env' ms'   go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do-    lift $ progress $ "Compiling " ++ runModuleName moduleName'+    lift . progress $ CompilingModule moduleName'      (checked@(Module _ _ elaborated _), env') <- lift . runCheck' env $ typeCheckModule Nothing m     checkExhaustiveModule env' checked     regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated@@ -168,8 +176,7 @@         corefn = CF.moduleToCoreFn env' mod'         [renamed] = renameInModules [corefn]         exts = moduleToPs mod' env'-    nextVar <- fresh-    lift $ codegen renamed env' nextVar exts+    codegen renamed env' exts     go env' ms'    rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]@@ -237,8 +244,8 @@ -- A set of make actions that read and write modules from the given directory. -- buildMakeActions :: FilePath -- ^ the output directory-                 -> M.Map ModuleName (Either RebuildPolicy String) -- ^ a map between module names and paths to the file containing the PureScript module-                 -> M.Map ModuleName (FilePath, ForeignJS) -- ^ a map between module name and the file containing the foreign javascript for the module+                 -> M.Map ModuleName (Either RebuildPolicy FilePath) -- ^ a map between module names and paths to the file containing the PureScript module+                 -> M.Map ModuleName FilePath -- ^ a map between module name and the file containing the foreign javascript for the module                  -> Bool -- ^ Generate a prefix comment?                  -> MakeActions Make buildMakeActions outputDir filePathMap foreigns usePrefix =@@ -249,7 +256,7 @@   getInputTimestamp mn = do     let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap     e1 <- traverseEither getTimestamp path-    fPath <- maybe (return Nothing) (getTimestamp . fst) $ M.lookup mn foreigns+    fPath <- maybe (return Nothing) getTimestamp $ M.lookup mn foreigns     return $ fmap (max fPath) e1    getOutputTimestamp :: ModuleName -> Make (Maybe UTCTime)@@ -264,29 +271,28 @@     let path = outputDir </> runModuleName mn </> "externs.purs"     (path, ) <$> readTextFile path -  codegen :: CF.Module CF.Ann -> Environment -> SupplyVar -> Externs -> Make ()-  codegen m _ nextVar exts = do+  codegen :: CF.Module CF.Ann -> Environment -> Externs -> SupplyT Make ()+  codegen m _ exts = do     let mn = CF.moduleName m     foreignInclude <- case mn `M.lookup` foreigns of-      Just (path, _)+      Just path         | not $ requiresForeign m -> do             tell $ errorMessage $ UnnecessaryFFIModule mn path             return Nothing         | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]       Nothing | requiresForeign m -> throwError . errorMessage $ MissingFFIModule mn               | otherwise -> return Nothing-    pjs <- evalSupplyT nextVar $ prettyPrintJS <$> J.moduleToJs m foreignInclude+    pjs <- prettyPrintJS <$> J.moduleToJs m foreignInclude     let filePath = runModuleName mn         jsFile = outputDir </> filePath </> "index.js"         externsFile = outputDir </> filePath </> "externs.purs"         foreignFile = outputDir </> filePath </> "foreign.js"         prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]         js = unlines $ map ("// " ++) prefix ++ [pjs]-    verboseErrorsEnabled <- asks optionsVerboseErrors-    when verboseErrorsEnabled $ progress $ "Writing " ++ jsFile-    writeTextFile jsFile js-    maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns-    writeTextFile externsFile exts+    lift $ do+      writeTextFile jsFile js+      for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)+      writeTextFile externsFile exts    requiresForeign :: CF.Module a -> Bool   requiresForeign = not . null . CF.moduleForeign@@ -307,5 +313,5 @@     mkdirp :: FilePath -> IO ()     mkdirp = createDirectoryIfMissing True . takeDirectory -  progress :: String -> Make ()-  progress = liftIO . putStrLn+  progress :: ProgressMessage -> Make ()+  progress = liftIO . putStrLn . renderProgressMessage

@@ -229,7 +229,21 @@   members <- P.option [] . P.try $ do     indented *> reserved "where"     mark (P.many (same *> positioned parseValueDeclaration))-  return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members+  return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty (ExplicitInstance members)+  +parseDerivingInstanceDeclaration :: TokenParser Declaration+parseDerivingInstanceDeclaration = do+  reserved "derive"+  reserved "instance"+  name <- parseIdent <* indented <* doubleColon+  deps <- P.optionMaybe $ do+    deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))+    indented+    rfatArrow+    return deps+  className <- indented *> parseQualified properName+  ty <- P.many (indented *> noWildcards parseTypeAtom)+  return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty DerivedInstance  positioned :: TokenParser Declaration -> TokenParser Declaration positioned = withSourceSpan PositionedDeclaration@@ -248,6 +262,7 @@                    , parseImportDeclaration                    , parseTypeClassDeclaration                    , parseTypeInstanceDeclaration+                   , parseDerivingInstanceDeclaration                    ]) P.<?> "declaration"  parseLocalDeclaration :: TokenParser Declaration

@@ -37,17 +37,17 @@  parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)                              => [(FilePath, ForeignJS)]-                             -> m (M.Map ModuleName (FilePath, ForeignJS))+                             -> m (M.Map ModuleName FilePath) parseForeignModulesFromFiles files = do   foreigns <- parU files $ \(path, file) ->     case findModuleName (lines file) of-      Just name -> return (name, (path, file))+      Just name -> return (name, path)       Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)   let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns   forM_ grouped $ \grp ->     when (length grp > 1) $ do       let mn = fst (head grp)-          paths = map (fst . snd) grp+          paths = map snd grp       tell $ errorMessage $ MultipleFFIModules mn paths   return $ M.fromList foreigns 

@@ -494,6 +494,7 @@                   , "infix"                   , "class"                   , "instance"+                  , "derive"                   , "module"                   , "case"                   , "of"

@@ -163,6 +163,7 @@   encodeChar '\\' = "\\\\"   encodeChar c | fromEnum c > 0xFFF = "\\u" ++ showHex (fromEnum c) ""   encodeChar c | fromEnum c > 0xFF = "\\u0" ++ showHex (fromEnum c) ""+  encodeChar c | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" ++ showHex (fromEnum c) ""   encodeChar c = [c]  conditional :: Pattern PrinterState JS ((JS, JS), JS)

@@ -198,12 +198,12 @@   ParseAndDesugarError (D.SortModulesError err) ->     vcat       [ para "Error in sortModules:"-      , indented (para (P.prettyPrintMultipleErrors False err))+      , indented (P.prettyPrintMultipleErrorsBox False err)       ]   ParseAndDesugarError (D.DesugarError err) ->     vcat       [ para "Error while desugaring:"-      , indented (para (P.prettyPrintMultipleErrors False err))+      , indented (P.prettyPrintMultipleErrorsBox False err)       ]   DirtyWorkingTree ->     para (concat

@@ -33,6 +33,7 @@ import Language.PureScript.Sugar.ObjectWildcards as S import Language.PureScript.Sugar.Operators as S import Language.PureScript.Sugar.TypeClasses as S+import Language.PureScript.Sugar.TypeClasses.Deriving as S import Language.PureScript.Sugar.TypeDeclarations as S  -- |@@ -67,5 +68,6 @@           >=> desugarTypeDeclarationsModule           >=> desugarImports           >=> rebracket+          >=> mapM deriveInstances           >=> desugarTypeClasses           >=> createBindingGroupsModule

@@ -68,7 +68,7 @@   where     desugarRest :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]     desugarRest (TypeInstanceDeclaration name constraints className tys ds : rest) =-      (:) <$> (TypeInstanceDeclaration name constraints className tys <$> desugarCases ds) <*> desugarRest rest+      (:) <$> (TypeInstanceDeclaration name constraints className tys <$> traverseTypeInstanceBody desugarCases ds) <*> desugarRest rest     desugarRest (ValueDeclaration name nameKind bs result : rest) =       let (_, f, _) = everywhereOnValuesTopDownM return go return           f' (Left gs) = Left <$> mapM (pairM return f) gs

@@ -166,7 +166,8 @@     modify (M.insert (mn, name) d)     return (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)   go d@(ExternInstanceDeclaration name _ className tys) = return (expRef name className tys, [d])-  go d@(TypeInstanceDeclaration name deps className tys members) = do+  go (TypeInstanceDeclaration _ _ _ _ DerivedInstance) = error "Derived instanced should have been desugared"+  go d@(TypeInstanceDeclaration name deps className tys (ExplicitInstance members)) = do     desugared <- desugarCases members     dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared     return (expRef name className tys, [d, dictDecl])

@@ -0,0 +1,229 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  Language.PureScript.Sugar.TypeClasses.Deriving
+-- Copyright   :  (c) Gershom Bazerman 2015
+-- License     :  MIT (http://opensource.org/licenses/MIT)
+--
+-- Maintainer  :  Phil Freeman <paf31@cantab.net>
+-- Stability   :  experimental
+-- Portability :
+--
+-- |
+-- This module implements the generic deriving elaboration that takes place during desugaring.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Language.PureScript.Sugar.TypeClasses.Deriving (
+    deriveInstances
+) where
+
+import Data.List
+import Data.Maybe (fromMaybe)
+import Data.Ord (comparing)
+
+import Control.Applicative
+import Control.Monad (replicateM)
+import Control.Monad.Supply.Class (MonadSupply, freshName)
+import Control.Monad.Error.Class (MonadError(..))
+
+import Language.PureScript.AST
+import Language.PureScript.Environment
+import Language.PureScript.Errors
+import Language.PureScript.Names
+import Language.PureScript.Types
+import qualified Language.PureScript.Constants as C
+
+-- | Elaborates deriving instance declarations by code generation.
+deriveInstances ::  (Functor m, Applicative m, MonadError MultipleErrors m, MonadSupply m) => Module -> m Module
+deriveInstances (Module coms mn ds exts) = Module coms mn <$> mapM (deriveInstance mn ds) ds <*> pure exts
+
+-- | Takes a declaration, and if the declaration is a deriving TypeInstanceDeclaration, 
+-- elaborates that into an instance declaration via code generation.
+deriveInstance :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> Declaration -> m Declaration
+deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] DerivedInstance) 
+  | className == Qualified (Just dataGeneric) (ProperName C.generic)
+  , Just (Qualified mn' tyCon) <- unwrapTypeConstructor ty
+  , mn == fromMaybe mn mn'
+  = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon
+deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance) 
+  = throwError . errorMessage $ CannotDerive className tys
+deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d
+deriveInstance _  _  e = return e
+
+unwrapTypeConstructor :: Type -> Maybe (Qualified ProperName)
+unwrapTypeConstructor (TypeConstructor tyCon) = Just tyCon
+unwrapTypeConstructor (TypeApp ty (TypeVar _)) = unwrapTypeConstructor ty
+unwrapTypeConstructor _ = Nothing
+
+dataGeneric :: ModuleName
+dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]
+
+dataMaybe :: ModuleName
+dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]
+
+deriveGeneric :: (Functor m, MonadError MultipleErrors m, MonadSupply m) => ModuleName -> [Declaration] -> ProperName -> m [Declaration]
+deriveGeneric mn ds tyConNm = do
+  tyCon <- findTypeDecl tyConNm ds
+  toSpine <- mkSpineFunction mn tyCon
+  fromSpine <- mkFromSpineFunction mn tyCon
+  let toSignature = mkSignatureFunction mn tyCon
+  return [ ValueDeclaration (Ident C.toSpine) Public [] (Right toSpine)
+         , ValueDeclaration (Ident C.fromSpine) Public [] (Right fromSpine)
+         , ValueDeclaration (Ident C.toSignature) Public [] (Right toSignature)
+         ]
+
+findTypeDecl :: (Functor m, MonadError MultipleErrors m) => ProperName -> [Declaration] -> m Declaration
+findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType tyConNm) return . find isTypeDecl
+  where
+  isTypeDecl :: Declaration -> Bool
+  isTypeDecl (DataDeclaration _ nm _ _) | nm == tyConNm = True
+  isTypeDecl (PositionedDeclaration _ _ d) = isTypeDecl d
+  isTypeDecl _ = False
+
+mkSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
+mkSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorClause args
+  where
+  prodConstructor :: Expr -> Expr      
+  prodConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SProd")))
+
+  recordConstructor :: Expr -> Expr
+  recordConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SRecord")))
+
+  mkCtorClause :: (ProperName, [Type]) -> m CaseAlternative
+  mkCtorClause (ctorName, tys) = do
+    idents <- replicateM (length tys) (fmap Ident freshName)
+    return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right (caseResult idents))
+    where 
+    caseResult idents = 
+      App (prodConstructor (StringLiteral . runProperName $ ctorName)) 
+        . ArrayLiteral 
+        $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys
+
+  toSpineFun :: Expr -> Type -> Expr
+  toSpineFun i r | Just rec <- objectType r =
+      lamNull . recordConstructor . ArrayLiteral .
+          map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
+          $ decomposeRec rec
+  toSpineFun i _ = lamNull $ App (mkGenVar C.toSpine) i
+mkSpineFunction mn (PositionedDeclaration _ _ d) = mkSpineFunction mn d
+mkSpineFunction _ _ = error "mkSpineFunction: expected DataDeclaration"
+
+mkSignatureFunction :: ModuleName -> Declaration -> Expr
+mkSignatureFunction _ (DataDeclaration _ _ _ args) = lamNull . mkSigProd $ map mkProdClause args
+  where
+  mkSigProd :: [Expr] -> Expr      
+  mkSigProd = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd"))) . ArrayLiteral
+
+  mkSigRec :: [Expr] -> Expr      
+  mkSigRec = App (Constructor (Qualified (Just dataGeneric) (ProperName "SigRecord"))) . ArrayLiteral
+  
+  proxy :: Type -> Type
+  proxy = TypeApp (TypeConstructor (Qualified (Just dataGeneric) (ProperName "Proxy")))
+  
+  mkProdClause :: (ProperName, [Type]) -> Expr
+  mkProdClause (ctorName, tys) = ObjectLiteral [ ("sigConstructor", StringLiteral (runProperName ctorName))
+                                               , ("sigValues", ArrayLiteral . map mkProductSignature $ tys)
+                                               ]
+
+  mkProductSignature :: Type -> Expr
+  mkProductSignature r | Just rec <- objectType r =
+      lamNull . mkSigRec $ [ ObjectLiteral [ ("recLabel", StringLiteral str)
+                                           , ("recValue", mkProductSignature typ)
+                                           ]
+                           | (str, typ) <- decomposeRec rec
+                           ]
+  mkProductSignature typ = lamNull $ App (mkGenVar C.toSignature)
+                           (TypedValue False (mkGenVar "anyProxy") (proxy typ))
+mkSignatureFunction mn (PositionedDeclaration _ _ d) = mkSignatureFunction mn d
+mkSignatureFunction _ _ = error "mkSignatureFunction: expected DataDeclaration"
+
+mkFromSpineFunction :: forall m. (Functor m, MonadSupply m) => ModuleName -> Declaration -> m Expr
+mkFromSpineFunction mn (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch <$> mapM mkAlternative args)
+  where
+  mkJust :: Expr -> Expr      
+  mkJust = App (Constructor (Qualified (Just dataMaybe) (ProperName "Just")))
+
+  mkNothing :: Expr      
+  mkNothing = Constructor (Qualified (Just dataMaybe) (ProperName "Nothing"))
+  
+  prodBinder :: [Binder] -> Binder      
+  prodBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SProd"))
+
+  recordBinder :: [Binder] -> Binder    
+  recordBinder = ConstructorBinder (Qualified (Just dataGeneric) (ProperName "SRecord"))
+ 
+  mkAlternative :: (ProperName, [Type]) -> m CaseAlternative
+  mkAlternative (ctorName, tys) = do
+    idents <- replicateM (length tys) (fmap Ident freshName)
+    return $ CaseAlternative [ prodBinder [ StringBinder (runProperName ctorName), ArrayBinder (map VarBinder idents)]]
+               . Right 
+               $ liftApplicative (mkJust $ Constructor (Qualified (Just mn) ctorName)) 
+                                 (zipWith fromSpineFun (map (Var . (Qualified Nothing)) idents) tys)
+
+  addCatch :: [CaseAlternative] -> [CaseAlternative]
+  addCatch = (++ [catchAll])
+    where
+    catchAll = CaseAlternative [NullBinder] (Right mkNothing)
+
+  fromSpineFun e r 
+    | Just rec <- objectType r 
+    = App (lamCase "r" [ mkRecCase (decomposeRec rec)
+                       , CaseAlternative [NullBinder] (Right mkNothing)
+                       ]) 
+          (App e (mkPrelVar "unit"))
+
+  fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
+  
+  mkRecCase rs = CaseAlternative [ recordBinder [ ArrayBinder (map (VarBinder . Ident . fst) rs) 
+                                                ]
+                                 ] 
+                   . Right 
+                   $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar x)) y) rs)
+
+  mkRecFun :: [(String, Type)] -> Expr
+  mkRecFun xs = mkJust $ foldr (\s e -> lam s e) recLiteral (map fst xs)
+     where recLiteral = ObjectLiteral $ map (\(s,_) -> (s,mkVar s)) xs
+mkFromSpineFunction mn (PositionedDeclaration _ _ d) = mkFromSpineFunction mn d
+mkFromSpineFunction _ _ = error "mkFromSpineFunction: expected DataDeclaration"
+
+-- Helpers
+
+objectType :: Type -> Maybe Type
+objectType (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Object"))) rec) = Just rec
+objectType _ = Nothing
+
+lam :: String -> Expr -> Expr
+lam s = Abs (Left (Ident s))
+
+lamNull :: Expr -> Expr
+lamNull = lam "$q"
+
+lamCase :: String -> [CaseAlternative] -> Expr
+lamCase s = lam s . Case [mkVar s]
+
+liftApplicative :: Expr -> [Expr] -> Expr
+liftApplicative = foldl' (\x e -> App (App (mkPrelVar "apply") x) e)
+
+mkVarMn :: Maybe ModuleName -> String -> Expr
+mkVarMn mn s = Var (Qualified mn (Ident s))
+
+mkVar :: String -> Expr
+mkVar s = mkVarMn Nothing s
+
+mkPrelVar :: String -> Expr
+mkPrelVar s = mkVarMn (Just (ModuleName [ProperName C.prelude])) s
+
+mkGenVar :: String -> Expr
+mkGenVar s = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic])) s
+
+decomposeRec :: Type -> [(String, Type)]
+decomposeRec = sortBy (comparing fst) . go
+    where go (RCons str typ typs) = (str, typ) : decomposeRec typs
+          go _ = []

@@ -1,8 +1,8 @@ ----------------------------------------------------------------------------- -- -- Module      :  Language.PureScript.TypeChecker--- Copyright   :  (c) Phil Freeman 2013--- License     :  MIT+-- Copyright   :  (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess+-- License     :  MIT (http://opensource.org/licenses/MIT) -- -- Maintainer  :  Phil Freeman <paf31@cantab.net> -- Stability   :  experimental@@ -235,11 +235,25 @@   goInstance d dictName deps className tys = do     mapM_ (checkTypeClassInstance moduleName) tys     forM_ deps $ mapM_ (checkTypeClassInstance moduleName) . snd+    checkOrphanInstance moduleName className tys     let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className tys (Just deps) TCDRegular isInstanceExported     addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (canonicalizeDictionary dict) dict     return d      where++    checkOrphanInstance :: ModuleName -> Qualified ProperName -> [Type] -> Check ()+    checkOrphanInstance mn (Qualified (Just mn') _) tys+      | mn == mn' || any checkType tys = return ()+      | otherwise = throwError . errorMessage $ OrphanInstance dictName className tys+      where+      checkType :: Type -> Bool+      checkType (TypeVar _) = False+      checkType (TypeConstructor (Qualified (Just mn'') _)) = mn == mn''+      checkType (TypeConstructor (Qualified Nothing _)) = error "Unqualified type name in checkOrphanInstance"+      checkType (TypeApp t1 _) = checkType t1+      checkType _ = error "Invalid type in instance in checkOrphanInstance"+    checkOrphanInstance _ _ _ = error "Unqualified class name in checkOrphanInstance"      isInstanceExported :: Bool     isInstanceExported = any exportsInstance exps

@@ -578,6 +578,7 @@   go (SaturatedTypeSynonym _ _) = True   go _ = False + -- | -- Check the type of a collection of named record fields --

@@ -69,61 +69,25 @@ modulesDir :: FilePath modulesDir = ".test_modules" </> "node_modules" -newtype Test a = Test { unTest :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }-  deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)--runTest :: Test a -> IO (Either P.MultipleErrors a)-runTest = runExceptT . fmap fst . runWriterT . flip runReaderT P.defaultOptions . unTest--makeActions :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> P.MakeActions Test-makeActions foreigns = P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress+makeActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make+makeActions foreigns = (P.buildMakeActions modulesDir (error "makeActions: input file map was read.") foreigns False)+                         { P.getInputTimestamp = getInputTimestamp+                         , P.getOutputTimestamp = getOutputTimestamp+                         }   where-  getInputTimestamp :: P.ModuleName -> Test (Either P.RebuildPolicy (Maybe UTCTime))+  getInputTimestamp :: P.ModuleName -> P.Make (Either P.RebuildPolicy (Maybe UTCTime))   getInputTimestamp mn     | isSupportModule (P.runModuleName mn) = return (Left P.RebuildNever)     | otherwise = return (Left P.RebuildAlways)     where     isSupportModule = flip elem supportModules -  getOutputTimestamp :: P.ModuleName -> Test (Maybe UTCTime)+  getOutputTimestamp :: P.ModuleName -> P.Make (Maybe UTCTime)   getOutputTimestamp mn = do     let filePath = modulesDir </> P.runModuleName mn     exists <- liftIO $ doesDirectoryExist filePath     return (if exists then Just (error "getOutputTimestamp: read timestamp") else Nothing) -  readExterns :: P.ModuleName -> Test (FilePath, String)-  readExterns mn = do-    let filePath = modulesDir </> P.runModuleName mn </> "externs.purs"-    (filePath, ) <$> readTextFile filePath--  codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Test ()-  codegen m _ nextVar exts = do-    let mn = CF.moduleName m-    foreignInclude <- case (CF.moduleName m `M.lookup` foreigns, CF.moduleForeign m) of-      (Just _, [])   -> error "Unnecessary foreign module"-      (Just path, _) -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]-      (Nothing, [])  -> return Nothing-      (Nothing, _)   -> error "Missing foreign module"-    pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude-    let filePath    = P.runModuleName $ CF.moduleName m-        jsFile      = modulesDir </> filePath </> "index.js"-        externsFile = modulesDir </> filePath </> "externs.purs"-        foreignFile = modulesDir </> filePath </> "foreign.js"-    writeTextFile jsFile pjs-    maybe (return ()) (writeTextFile foreignFile . snd) $ CF.moduleName m `M.lookup` foreigns-    writeTextFile externsFile exts--  readTextFile :: FilePath -> Test String-  readTextFile path = liftIO $ readFile path--  writeTextFile :: FilePath -> String -> Test ()-  writeTextFile path text = liftIO $ do-    createDirectoryIfMissing True (takeDirectory path)-    writeFile path text--  progress :: String -> Test ()-  progress = liftIO . putStrLn- readInput :: [FilePath] -> IO [(FilePath, String)] readInput inputFiles = forM inputFiles $ \inputFile -> do   text <- readFile inputFile@@ -131,14 +95,17 @@  type TestM = WriterT [(FilePath, String)] IO -compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)+runTest :: P.Make a -> IO (Either P.MultipleErrors a)+runTest = fmap (fmap fst) . P.runMake P.defaultOptions++compile :: [FilePath] -> M.Map P.ModuleName FilePath -> IO (Either P.MultipleErrors P.Environment) compile inputFiles foreigns = runTest $ do   fs <- liftIO $ readInput inputFiles   ms <- P.parseModulesFromFiles id fs   P.make (makeActions foreigns) (map snd ms)  assert :: [FilePath] ->-          M.Map P.ModuleName (FilePath, P.ForeignJS) ->+          M.Map P.ModuleName FilePath ->           (Either P.MultipleErrors P.Environment -> IO (Maybe String)) ->           TestM () assert inputFiles foreigns f = do@@ -148,7 +115,7 @@     Just err -> tell [(last inputFiles, err)]     Nothing -> return () -assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()+assertCompiles :: [FilePath] -> M.Map P.ModuleName FilePath -> TestM () assertCompiles inputFiles foreigns = do   liftIO . putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"   assert inputFiles foreigns $ \e ->@@ -164,7 +131,7 @@           Just (ExitFailure _, _, err) -> return $ Just err           Nothing -> return $ Just "Couldn't find node.js executable" -assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()+assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName FilePath -> TestM () assertDoesNotCompile inputFiles foreigns = do   let testFile = last inputFiles   liftIO . putStrLn $ "Assert " ++ testFile ++ " does not compile"@@ -242,7 +209,9 @@ fetchSupportCode = do   setCurrentDirectory "tests/support"   callProcess "npm" ["install"]-  callProcess "bower" ["install"]+  -- Sometimes we run as a root (e.g. in simple docker containers)+  -- And we are non-interactive: https://github.com/bower/bower/issues/1162+  callProcess "node_modules/.bin/bower" ["--allow-root", "install", "--config.interactive=false"]   callProcess "node" ["setup.js"]   setCurrentDirectory "../.." 

@@ -0,0 +1,11 @@+{+  "name": "purescript-test-suite-support",+  "dependencies": {+    "purescript-eff": "0.1.0",+    "purescript-prelude": "0.1.1",+    "purescript-assert": "0.1.1",+    "purescript-st": "0.1.0",+    "purescript-console": "0.1.0",+    "purescript-functions": "0.1.0"+  }+}

@@ -1,24 +0,0 @@-module Control.Monad.Eff.Class -  ( MonadEff-  , liftEff-  ) where--import Prelude--import Control.Monad.Eff---- | The `MonadEff` class captures those monads which support native effects.--- |--- | Instances are provided for `Eff` itself, and the standard monad transformers.--- |--- | `liftEff` can be used in any appropriate monad transformer stack to lift an action--- | of type `Eff eff a` into the monad.--- |--- | Note that `MonadEff` is parameterized by the row of effects, so type inference can be--- | tricky. It is generally recommended to either work with a polymorphic row of effects,--- | or a concrete, closed row of effects such as `(trace :: Trace)`.-class (Monad m) <= MonadEff eff m where-  liftEff :: forall a. Eff eff a -> m a--instance monadEffEff :: MonadEff eff (Eff eff) where-  liftEff = id

@@ -1,18 +0,0 @@-/* global exports, console */-"use strict";--// module Control.Monad.Eff.Console--exports.log = function (s) {-  return function () {-    console.log(s);-    return {};-  };-};--exports.error = function (s) {-  return function () {-    console.error(s);-    return {};-  };-};

@@ -1,18 +0,0 @@-module Control.Monad.Eff.Console where--import Prelude--import Control.Monad.Eff---- | The `CONSOLE` effect represents those computations which write to the console.-foreign import data CONSOLE :: !---- | Write a message to the console.-foreign import log :: forall eff. String -> Eff (console :: CONSOLE | eff) Unit---- | Write an error to the console.-foreign import error :: forall eff. String -> Eff (console :: CONSOLE | eff) Unit---- | Write a value to the console, using its `Show` instance to produce a `String`.-print :: forall a eff. (Show a) => a -> Eff (console :: CONSOLE | eff) Unit-print = log <<< show

@@ -1,8 +0,0 @@-/* global exports */-"use strict";--// module Control.Monad.Eff.Unsafe--exports.unsafeInterleaveEff = function (f) {-  return f;-};

@@ -1,10 +0,0 @@-module Control.Monad.Eff.Unsafe where--import Prelude--import Control.Monad.Eff---- | Change the type of an effectful computation, allowing it to be run in another context.--- |--- | Note: use of this function can result in arbitrary side-effects.-foreign import unsafeInterleaveEff :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

@@ -1,62 +0,0 @@-/* global exports */-"use strict";--// module Control.Monad.Eff--exports.returnE = function (a) {-  return function () {-    return a;-  };-};--exports.bindE = function (a) {-  return function (f) {-    return function () {-      return f(a())();-    };-  };-};--exports.runPure = function (f) {-  return f();-};--exports.untilE = function (f) {-  return function () {-    while (!f());-    return {};-  };-};--exports.whileE = function (f) {-  return function (a) {-    return function () {-      while (f()) {-        a();-      }-      return {};-    };-  };-};--exports.forE = function (lo) {-  return function (hi) {-    return function (f) {-      return function () {-        for (var i = lo; i < hi; i++) {-          f(i)();-        }-      };-    };-  };-};--exports.foreachE = function (as) {-  return function (f) {-    return function () {-      for (var i = 0, l = as.length; i < l; i++) {-        f(as[i])();-      }-    };-  };-};

@@ -1,67 +0,0 @@-module Control.Monad.Eff-  ( Eff()-  , Pure()-  , runPure-  , untilE, whileE, forE, foreachE-  ) where--import Prelude---- | The `Eff` type constructor is used to represent _native_ effects.--- |--- | See [Handling Native Effects with the Eff Monad](https://github.com/purescript/purescript/wiki/Handling-Native-Effects-with-the-Eff-Monad) for more details.--- |--- | The first type parameter is a row of effects which represents the contexts in which a computation can be run, and the second type parameter is the return type.-foreign import data Eff :: # ! -> * -> *--foreign import returnE :: forall e a. a -> Eff e a--foreign import bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b---- | The `Pure` type synonym represents _pure_ computations, i.e. ones in which all effects have been handled.--- |--- | The `runPure` function can be used to run pure computations and obtain their result.-type Pure a = forall e. Eff e a---- | Run a pure computation and return its result.--- |--- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach--- | is to use parentheses instead.-foreign import runPure :: forall a. Pure a -> a--instance functorEff :: Functor (Eff e) where-  map = liftA1--instance applyEff :: Apply (Eff e) where-  apply = ap--instance applicativeEff :: Applicative (Eff e) where-  pure = returnE--instance bindEff :: Bind (Eff e) where-  bind = bindE--instance monadEff :: Monad (Eff e)---- | Loop until a condition becomes `true`.--- |--- | `untilE b` is an effectful computation which repeatedly runs the effectful computation `b`,--- | until its return value is `true`.-foreign import untilE :: forall e. Eff e Boolean -> Eff e Unit---- | Loop while a condition is `true`.--- |--- | `whileE b m` is effectful computation which runs the effectful computation `b`. If its result is--- | `true`, it runs the effectful computation `m` and loops. If not, the computation ends.-foreign import whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit---- | Loop over a consecutive collection of numbers.--- |--- | `forE lo hi f` runs the computation returned by the function `f` for each of the inputs--- | between `lo` (inclusive) and `hi` (exclusive).-foreign import forE :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit---- | Loop over an array of values.--- |--- | `foreach xs f` runs the computation returned by the function `f` for each of the inputs `xs`.-foreign import foreachE :: forall e a. Array a -> (a -> Eff e Unit) -> Eff e Unit

@@ -1,38 +0,0 @@-/* global exports */-"use strict";--// module Control.Monad.ST--exports.newSTRef = function (val) {-  return function () {-    return { value: val };-  };-};--exports.readSTRef = function (ref) {-  return function () {-    return ref.value;-  };-};--exports.modifySTRef = function (ref) {-  return function (f) {-    return function () {-      /* jshint boss: true */-      return ref.value = f(ref.value);-    };-  };-};--exports.writeSTRef = function (ref) {-  return function (a) {-    return function () {-      /* jshint boss: true */-      return ref.value = a;-    };-  };-};--exports.runST = function (f) {-  return f;-};

@@ -1,42 +0,0 @@-module Control.Monad.ST where--import Prelude--import Control.Monad.Eff (Eff(), runPure)---- | The `ST` effect represents _local mutation_, i.e. mutation which does not "escape" into the surrounding computation.--- |--- | An `ST` computation is parameterized by a phantom type which is used to restrict the set of reference cells it is allowed to access.--- |--- | The `runST` function can be used to handle the `ST` effect.-foreign import data ST :: * -> !---- | The type `STRef s a` represents a mutable reference holding a value of type `a`, which can be used with the `ST s` effect.-foreign import data STRef :: * -> * -> *---- | Create a new mutable reference.-foreign import newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)---- | Read the current value of a mutable reference.-foreign import readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a---- | Modify the value of a mutable reference by applying a function to the current value.-foreign import modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a---- | Set the value of a mutable reference.-foreign import writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a---- | Run an `ST` computation.--- |--- | Note: the type of `runST` uses a rank-2 type to constrain the phantom type `s`, such that the computation must not leak any mutable references--- | to the surrounding computation.--- |--- | It may cause problems to apply this function using the `$` operator. The recommended approach is to use parentheses instead.-foreign import runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a---- | A convenience function which combines `runST` with `runPure`, which can be used when the only required effect is `ST`.--- |--- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach--- | is to use parentheses instead.-pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a-pureST st = runPure (runST st)

@@ -1,233 +0,0 @@-/* global exports */-"use strict";--// module Data.Function--exports.mkFn0 = function (fn) {-  return function () {-    return fn({});-  };-};--exports.mkFn1 = function (fn) {-  return function (a) {-    return fn(a);-  };-};--exports.mkFn2 = function (fn) {-  /* jshint maxparams: 2 */-  return function (a, b) {-    return fn(a)(b);-  };-};--exports.mkFn3 = function (fn) {-  /* jshint maxparams: 3 */-  return function (a, b, c) {-    return fn(a)(b)(c);-  };-};--exports.mkFn4 = function (fn) {-  /* jshint maxparams: 4 */-  return function (a, b, c, d) {-    return fn(a)(b)(c)(d);-  };-};--exports.mkFn5 = function (fn) {-  /* jshint maxparams: 5 */-  return function (a, b, c, d, e) {-    return fn(a)(b)(c)(d)(e);-  };-};--exports.mkFn6 = function (fn) {-  /* jshint maxparams: 6 */-  return function (a, b, c, d, e, f) {-    return fn(a)(b)(c)(d)(e)(f);-  };-};--exports.mkFn7 = function (fn) {-  /* jshint maxparams: 7 */-  return function (a, b, c, d, e, f, g) {-    return fn(a)(b)(c)(d)(e)(f)(g);-  };-};--exports.mkFn8 = function (fn) {-  /* jshint maxparams: 8 */-  return function (a, b, c, d, e, f, g, h) {-    return fn(a)(b)(c)(d)(e)(f)(g)(h);-  };-};--exports.mkFn9 = function (fn) {-  /* jshint maxparams: 9 */-  return function (a, b, c, d, e, f, g, h, i) {-    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);-  };-};--exports.mkFn10 = function (fn) {-  /* jshint maxparams: 10 */-  return function (a, b, c, d, e, f, g, h, i, j) {-    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);-  };-};--exports.runFn0 = function (fn) {-  return fn();-};--exports.runFn1 = function (fn) {-  return function (a) {-    return fn(a);-  };-};--exports.runFn2 = function (fn) {-  return function (a) {-    return function (b) {-      return fn(a, b);-    };-  };-};--exports.runFn3 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return fn(a, b, c);-      };-    };-  };-};--exports.runFn4 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return fn(a, b, c, d);-        };-      };-    };-  };-};--exports.runFn5 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return fn(a, b, c, d, e);-          };-        };-      };-    };-  };-};--exports.runFn6 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return function (f) {-              return fn(a, b, c, d, e, f);-            };-          };-        };-      };-    };-  };-};--exports.runFn7 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return function (f) {-              return function (g) {-                return fn(a, b, c, d, e, f, g);-              };-            };-          };-        };-      };-    };-  };-};--exports.runFn8 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return function (f) {-              return function (g) {-                return function (h) {-                  return fn(a, b, c, d, e, f, g, h);-                };-              };-            };-          };-        };-      };-    };-  };-};--exports.runFn9 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return function (f) {-              return function (g) {-                return function (h) {-                  return function (i) {-                    return fn(a, b, c, d, e, f, g, h, i);-                  };-                };-              };-            };-          };-        };-      };-    };-  };-};--exports.runFn10 = function (fn) {-  return function (a) {-    return function (b) {-      return function (c) {-        return function (d) {-          return function (e) {-            return function (f) {-              return function (g) {-                return function (h) {-                  return function (i) {-                    return function (j) {-                      return fn(a, b, c, d, e, f, g, h, i, j);-                    };-                  };-                };-              };-            };-          };-        };-      };-    };-  };-};

@@ -1,113 +0,0 @@-module Data.Function where--import Prelude---- | The `on` function is used to change the domain of a binary operator.--- |--- | For example, we can create a function which compares two records based on the values of their `x` properties:--- |--- | ```purescript--- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering--- | compareX = compare `on` _.x--- | ```-on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c-on f g x y = g x `f` g y---- | A function of zero arguments-foreign import data Fn0 :: * -> *---- | A function of one argument-foreign import data Fn1 :: * -> * -> *---- | A function of two arguments-foreign import data Fn2 :: * -> * -> * -> *---- | A function of three arguments-foreign import data Fn3 :: * -> * -> * -> * -> *---- | A function of four arguments-foreign import data Fn4 :: * -> * -> * -> * -> * -> *---- | A function of five arguments-foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *---- | A function of six arguments-foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *---- | A function of seven arguments-foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *---- | A function of eight arguments-foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *---- | A function of nine arguments-foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *---- | A function of ten arguments-foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *---- | Create a function of no arguments-foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a---- | Create a function of one argument-foreign import mkFn1 :: forall a b. (a -> b) -> Fn1 a b---- | Create a function of two arguments from a curried function-foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c---- | Create a function of three arguments from a curried function-foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d---- | Create a function of four arguments from a curried function-foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e---- | Create a function of five arguments from a curried function-foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f---- | Create a function of six arguments from a curried function-foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g---- | Create a function of seven arguments from a curried function-foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h---- | Create a function of eight arguments from a curried function-foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i---- | Create a function of nine arguments from a curried function-foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j---- | Create a function of ten arguments from a curried function-foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k---- | Apply a function of no arguments-foreign import runFn0 :: forall a. Fn0 a -> a---- | Apply a function of one argument-foreign import runFn1 :: forall a b. Fn1 a b -> a -> b---- | Apply a function of two arguments-foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c---- | Apply a function of three arguments-foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d---- | Apply a function of four arguments-foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e---- | Apply a function of five arguments-foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f---- | Apply a function of six arguments-foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g---- | Apply a function of seven arguments-foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h---- | Apply a function of eight arguments-foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i---- | Apply a function of nine arguments-foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j---- | Apply a function of ten arguments-foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

@@ -1,222 +0,0 @@-/* global exports */-"use strict";--// module Prelude--//- Functor ----------------------------------------------------------------------exports.arrayMap = function (f) {-  return function (arr) {-    var l = arr.length;-    var result = new Array(l);-    for (var i = 0; i < l; i++) {-      result[i] = f(arr[i]);-    }-    return result;-  };-};--//- Bind -------------------------------------------------------------------------exports.arrayBind = function (arr) {-  return function (f) {-    var result = [];-    for (var i = 0, l = arr.length; i < l; i++) {-      Array.prototype.push.apply(result, f(arr[i]));-    }-    return result;-  };-};--//- Monoid -----------------------------------------------------------------------exports.concatString = function (s1) {-  return function (s2) {-    return s1 + s2;-  };-};--exports.concatArray = function (xs) {-  return function (ys) {-    return xs.concat(ys);-  };-};--//- Semiring ---------------------------------------------------------------------exports.intAdd = function (x) {-  return function (y) {-    /* jshint bitwise: false */-    return x + y | 0;-  };-};--exports.intMul = function (x) {-  return function (y) {-    /* jshint bitwise: false */-    return x * y | 0;-  };-};--exports.numAdd = function (n1) {-  return function (n2) {-    return n1 + n2;-  };-};--exports.numMul = function (n1) {-  return function (n2) {-    return n1 * n2;-  };-};--//- ModuloSemiring ---------------------------------------------------------------exports.intDiv = function (x) {-  return function (y) {-    /* jshint bitwise: false */-    return x / y | 0;-  };-};--exports.intMod = function (x) {-  return function (y) {-    return x % y;-  };-};--exports.numDiv = function (n1) {-  return function (n2) {-    return n1 / n2;-  };-};--//- Ring -------------------------------------------------------------------------exports.intSub = function (x) {-  return function (y) {-    /* jshint bitwise: false */-    return x - y | 0;-  };-};--exports.numSub = function (n1) {-  return function (n2) {-    return n1 - n2;-  };-};--//- Eq ---------------------------------------------------------------------------exports.refEq = function (r1) {-  return function (r2) {-    return r1 === r2;-  };-};--exports.refIneq = function (r1) {-  return function (r2) {-    return r1 !== r2;-  };-};--exports.eqArrayImpl = function (f) {-  return function (xs) {-    return function (ys) {-      if (xs.length !== ys.length) return false;-      for (var i = 0; i < xs.length; i++) {-        if (!f(xs[i])(ys[i])) return false;-      }-      return true;-    };-  };-};--exports.ordArrayImpl = function (f) {-  return function (xs) {-    return function (ys) {-      var i = 0;-      var xlen = xs.length;-      var ylen = ys.length;-      while (i < xlen && i < ylen) {-        var x = xs[i];-        var y = ys[i];-        var o = f(x)(y);-        if (o !== 0) {-          return o;-        }-        i++;-      }-      if (xlen === ylen) {-        return 0;-      } else if (xlen > ylen) {-        return -1;-      } else {-        return 1;-      }-    };-  };-};--//- Ord --------------------------------------------------------------------------exports.unsafeCompareImpl = function (lt) {-  return function (eq) {-    return function (gt) {-      return function (x) {-        return function (y) {-          return x < y ? lt : x > y ? gt : eq;-        };-      };-    };-  };-};--//- Lattice ----------------------------------------------------------------------exports.boolOr = function (b1) {-  return function (b2) {-    return b1 || b2;-  };-};--exports.boolAnd = function (b1) {-  return function (b2) {-    return b1 && b2;-  };-};--//- ComplementedLattice ----------------------------------------------------------exports.boolNot = function (b) {-  return !b;-};--//- Show -------------------------------------------------------------------------exports.showIntImpl = function (n) {-  return n.toString();-};--exports.showNumberImpl = function (n) {-  /* jshint bitwise: false */-  return n === (n | 0) ? n + ".0" : n.toString();-};--exports.showCharImpl = function (c) {-  return c === "'" ? "'\\''" : "'" + c + "'";-};--exports.showStringImpl = function (s) {-  return JSON.stringify(s);-};--exports.showArrayImpl = function (f) {-  return function (xs) {-    var ss = [];-    for (var i = 0, l = xs.length; i < l; i++) {-      ss[i] = f(xs[i]);-    }-    return "[" + ss.join(",") + "]";-  };-};

@@ -1,860 +0,0 @@-module Prelude-  ( Unit(), unit-  , ($), (#)-  , flip-  , const-  , asTypeOf-  , otherwise-  , Semigroupoid, compose, (<<<), (>>>)-  , Category, id-  , Functor, map, (<$>), (<#>), void-  , Apply, apply, (<*>)-  , Applicative, pure, liftA1-  , Bind, bind, (>>=)-  , Monad, return, liftM1, ap-  , Semigroup, append, (<>), (++)-  , Semiring, add, zero, mul, one, (+), (*)-  , ModuloSemiring, div, mod, (/)-  , Ring, sub, negate, (-)-  , Num-  , DivisionRing-  , Eq, eq, (==), (/=)-  , Ordering(..), Ord, compare, (<), (>), (<=), (>=)-  , unsafeCompare-  , Bounded, top, bottom-  , BoundedOrd-  , BooleanAlgebra, conj, disj, not, (&&), (||)-  , Show, show-  ) where---- | The `Unit` type has a single inhabitant, called `unit`. It represents--- | values with no computational content.--- |--- | `Unit` is often used, wrapped in a monadic type constructor, as the--- | return type of a computation where only--- | the _effects_ are important.-newtype Unit = Unit {}---- | `unit` is the sole inhabitant of the `Unit` type.-unit :: Unit-unit = Unit {}--infixr 0 $-infixl 1 #---- | Applies a function to its argument.--- |--- | ```purescript--- | length $ groupBy productCategory $ filter isInStock $ products--- | ```--- |--- | is equivalent to:--- |--- | ```purescript--- | length (groupBy productCategory (filter isInStock products))--- | ```--- |--- | `($)` is different from [`(#)`](#-2) because it is right-infix instead of--- | left: `a $ b $ c $ d x = a $ (b $ (c $ (d $ x))) = a (b (c (d x)))`-($) :: forall a b. (a -> b) -> a -> b-($) f x = f x---- | Applies an argument to a function.--- |--- | ```purescript--- | products # filter isInStock # groupBy productCategory # length--- | ```--- |--- | is equivalent to:--- |--- | ```purescript--- | length (groupBy productCategory (filter isInStock products))--- | ```--- |--- | `(#)` is different from [`($)`](#-1) because it is left-infix instead of--- | right: `x # a # b # c # d = (((x # a) # b) # c) # d = d (c (b (a x)))`-(#) :: forall a b. a -> (a -> b) -> b-(#) x f = f x---- | Flips the order of the arguments to a function of two arguments.--- |--- | ```purescript--- | flip const 1 2 = const 2 1 = 2--- | ```-flip :: forall a b c. (a -> b -> c) -> b -> a -> c-flip f b a = f a b---- | Returns its first argument and ignores its second.--- |--- | ```purescript--- | const 1 "hello" = 1--- | ```-const :: forall a b. a -> b -> a-const a _ = a---- | This function returns its first argument, and can be used to assert type--- | equalities. This can be useful when types are otherwise ambiguous.--- |--- | ```purescript--- | main = print $ [] `asTypeOf` [0]--- | ```--- |--- | If instead, we had written `main = print []`, the type of the argument--- | `[]` would have been ambiguous, resulting in a compile-time error.-asTypeOf :: forall a. a -> a -> a-asTypeOf x _ = x---- | An alias for `true`, which can be useful in guard clauses:--- |--- | ```purescript--- | max x y | x >= y    = x--- |         | otherwise = y--- | ```-otherwise :: Boolean-otherwise = true---- | A `Semigroupoid` is similar to a [`Category`](#category) but does not--- | require an identity element `id`, just composable morphisms.--- |--- | `Semigroupoid`s must satisfy the following law:--- |--- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r`--- |--- | One example of a `Semigroupoid` is the function type constructor `(->)`,--- | with `(<<<)` defined as function composition.-class Semigroupoid a where-  compose :: forall b c d. a c d -> a b c -> a b d--instance semigroupoidFn :: Semigroupoid (->) where-  compose f g x = f (g x)--infixr 9 >>>-infixr 9 <<<---- | `(<<<)` is an alias for `compose`.-(<<<) :: forall a b c d. (Semigroupoid a) => a c d -> a b c -> a b d-(<<<) = compose---- | Forwards composition, or `(<<<)` with its arguments reversed.-(>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d-(>>>) = flip compose---- | `Category`s consist of objects and composable morphisms between them, and--- | as such are [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids`--- | must have an identity element.--- |--- | Instances must satisfy the following law in addition to the--- | `Semigroupoid` law:--- |--- | - Identity: `id <<< p = p <<< id = p`-class (Semigroupoid a) <= Category a where-  id :: forall t. a t t--instance categoryFn :: Category (->) where-  id x = x---- | A `Functor` is a type constructor which supports a mapping operation--- | `(<$>)`.--- |--- | `(<$>)` can be used to turn functions `a -> b` into functions--- | `f a -> f b` whose argument and return types use the type constructor `f`--- | to represent some computational context.--- |--- | Instances must satisfy the following laws:--- |--- | - Identity: `(<$>) id = id`--- | - Composition: `(<$>) (f <<< g) = (f <$>) <<< (g <$>)`-class Functor f where-  map :: forall a b. (a -> b) -> f a -> f b--instance functorFn :: Functor ((->) r) where-  map = compose--instance functorArray :: Functor Array where-  map = arrayMap--foreign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b--infixl 4 <$>-infixl 1 <#>---- | `(<$>)` is an alias for `map`-(<$>) :: forall f a b. (Functor f) => (a -> b) -> f a -> f b-(<$>) = map---- | `(<#>)` is `(<$>)` with its arguments reversed. For example:--- |--- | ```purescript--- | [1, 2, 3] <#> \n -> n * n--- | ```-(<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b-(<#>) fa f = f <$> fa---- | The `void` function is used to ignore the type wrapped by a--- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type--- | information provided by the type constructor itself.--- |--- | `void` is often useful when using `do` notation to change the return type--- | of a monadic computation:--- |--- | ```purescript--- | main = forE 1 10 \n -> void do--- |   print n--- |   print (n * n)--- | ```-void :: forall f a. (Functor f) => f a -> f Unit-void fa = const unit <$> fa---- | The `Apply` class provides the `(<*>)` which is used to apply a function--- | to an argument under a type constructor.--- |--- | `Apply` can be used to lift functions of two or more arguments to work on--- | values wrapped with the type constructor `f`. It might also be understood--- | in terms of the `lift2` function:--- |--- | ```purescript--- | lift2 :: forall f a b c. (Apply f) => (a -> b -> c) -> f a -> f b -> f c--- | lift2 f a b = f <$> a <*> b--- | ```--- |--- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts--- | the function application operator `($)` to arguments wrapped with the--- | type constructor `f`.--- |--- | Instances must satisfy the following law in addition to the `Functor`--- | laws:--- |--- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`--- |--- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor.-class (Functor f) <= Apply f where-  apply :: forall a b. f (a -> b) -> f a -> f b--instance applyFn :: Apply ((->) r) where-  apply f g x = f x (g x)--instance applyArray :: Apply Array where-  apply = ap--infixl 4 <*>---- | `(<*>)` is an alias for `apply`.-(<*>) :: forall f a b. (Apply f) => f (a -> b) -> f a -> f b-(<*>) = apply---- | The `Applicative` type class extends the [`Apply`](#apply) type class--- | with a `pure` function, which can be used to create values of type `f a`--- | from values of type `a`.--- |--- | Where [`Apply`](#apply) provides the ability to lift functions of two or--- | more arguments to functions whose arguments are wrapped using `f`, and--- | [`Functor`](#functor) provides the ability to lift functions of one--- | argument, `pure` can be seen as the function which lifts functions of--- | _zero_ arguments. That is, `Applicative` functors support a lifting--- | operation for any number of function arguments.--- |--- | Instances must satisfy the following laws in addition to the `Apply`--- | laws:--- |--- | - Identity: `(pure id) <*> v = v`--- | - Composition: `(pure <<<) <*> f <*> g <*> h = f <*> (g <*> h)`--- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`--- | - Interchange: `u <*> (pure y) = (pure ($ y)) <*> u`-class (Apply f) <= Applicative f where-  pure :: forall a. a -> f a--instance applicativeFn :: Applicative ((->) r) where-  pure = const--instance applicativeArray :: Applicative Array where-  pure x = [x]---- | `return` is an alias for `pure`.-return :: forall m a. (Applicative m) => a -> m a-return = pure---- | `liftA1` provides a default implementation of `(<$>)` for any--- | [`Applicative`](#applicative) functor, without using `(<$>)` as provided--- | by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass--- | relationship.--- |--- | `liftA1` can therefore be used to write [`Functor`](#functor) instances--- | as follows:--- |--- | ```purescript--- | instance functorF :: Functor F where--- |   map = liftA1--- | ```-liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b-liftA1 f a = pure f <*> a---- | The `Bind` type class extends the [`Apply`](#apply) type class with a--- | "bind" operation `(>>=)` which composes computations in sequence, using--- | the return value of one computation to determine the next computation.--- |--- | The `>>=` operator can also be expressed using `do` notation, as follows:--- |--- | ```purescript--- | x >>= f = do y <- x--- |              f y--- | ```--- |--- | where the function argument of `f` is given the name `y`.--- |--- | Instances must satisfy the following law in addition to the `Apply`--- | laws:--- |--- | - Associativity: `(x >>= f) >>= g = x >>= (\k => f k >>= g)`--- |--- | Associativity tells us that we can regroup operations which use `do`--- | notation so that we can unambiguously write, for example:--- |--- | ```purescript--- | do x <- m1--- |    y <- m2 x--- |    m3 x y--- | ```-class (Apply m) <= Bind m where-  bind :: forall a b. m a -> (a -> m b) -> m b--instance bindFn :: Bind ((->) r) where-  bind m f x = f (m x) x--instance bindArray :: Bind Array where-  bind = arrayBind--foreign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b--infixl 1 >>=---- | `(>>=)` is an alias for `bind`.-(>>=) :: forall m a b. (Bind m) => m a -> (a -> m b) -> m b-(>>=) = bind---- | The `Monad` type class combines the operations of the `Bind` and--- | `Applicative` type classes. Therefore, `Monad` instances represent type--- | constructors which support sequential composition, and also lifting of--- | functions of arbitrary arity.--- |--- | Instances must satisfy the following laws in addition to the--- | `Applicative` and `Bind` laws:--- |--- | - Left Identity: `pure x >>= f = f x`--- | - Right Identity: `x >>= pure = x`-class (Applicative m, Bind m) <= Monad m--instance monadFn :: Monad ((->) r)-instance monadArray :: Monad Array---- | `liftM1` provides a default implementation of `(<$>)` for any--- | [`Monad`](#monad), without using `(<$>)` as provided by the--- | [`Functor`](#functor)-[`Monad`](#monad) superclass relationship.--- |--- | `liftM1` can therefore be used to write [`Functor`](#functor) instances--- | as follows:--- |--- | ```purescript--- | instance functorF :: Functor F where--- |   map = liftM1--- | ```-liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b-liftM1 f a = do-  a' <- a-  return (f a')---- | `ap` provides a default implementation of `(<*>)` for any--- | [`Monad`](#monad), without using `(<*>)` as provided by the--- | [`Apply`](#apply)-[`Monad`](#monad) superclass relationship.--- |--- | `ap` can therefore be used to write [`Apply`](#apply) instances as--- | follows:--- |--- | ```purescript--- | instance applyF :: Apply F where--- |   apply = ap--- | ```-ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b-ap f a = do-  f' <- f-  a' <- a-  return (f' a')---- | The `Semigroup` type class identifies an associative operation on a type.--- |--- | Instances are required to satisfy the following law:--- |--- | - Associativity: `(x <> y) <> z = x <> (y <> z)`--- |--- | One example of a `Semigroup` is `String`, with `(<>)` defined as string--- | concatenation.-class Semigroup a where-  append :: a -> a -> a--infixr 5 <>-infixr 5 ++---- | `(<>)` is an alias for `append`.-(<>) :: forall s. (Semigroup s) => s -> s -> s-(<>) = append---- | `(++)` is an alternative alias for `append`.-(++) :: forall s. (Semigroup s) => s -> s -> s-(++) = append--instance semigroupString :: Semigroup String where-  append = concatString--instance semigroupUnit :: Semigroup Unit where-  append _ _ = unit--instance semigroupFn :: (Semigroup s') => Semigroup (s -> s') where-  append f g = \x -> f x <> g x--instance semigroupOrdering :: Semigroup Ordering where-  append LT _ = LT-  append GT _ = GT-  append EQ y = y--instance semigroupArray :: Semigroup (Array a) where-  append = concatArray--foreign import concatString :: String -> String -> String-foreign import concatArray :: forall a. Array a -> Array a -> Array a---- | The `Semiring` class is for types that support an addition and--- | multiplication operation.--- |--- | Instances must satisfy the following laws:--- |--- | - Commutative monoid under addition:--- |   - Associativity: `(a + b) + c = a + (b + c)`--- |   - Identity: `zero + a = a + zero = a`--- |   - Commutative: `a + b = b + a`--- | - Monoid under multiplication:--- |   - Associativity: `(a * b) * c = a * (b * c)`--- |   - Identity: `one * a = a * one = a`--- | - Multiplication distributes over addition:--- |   - Left distributivity: `a * (b + c) = (a * b) + (a * c)`--- |   - Right distributivity: `(a + b) * c = (a * c) + (b * c)`--- | - Annihiliation: `zero * a = a * zero = zero`-class Semiring a where-  add  :: a -> a -> a-  zero :: a-  mul  :: a -> a -> a-  one  :: a--instance semiringInt :: Semiring Int where-  add = intAdd-  zero = 0-  mul = intMul-  one = 1--instance semiringNumber :: Semiring Number where-  add = numAdd-  zero = 0.0-  mul = numMul-  one = 1.0--instance semiringUnit :: Semiring Unit where-  add _ _ = unit-  zero = unit-  mul _ _ = unit-  one = unit--infixl 6 +-infixl 7 *---- | `(+)` is an alias for `add`.-(+) :: forall a. (Semiring a) => a -> a -> a-(+) = add---- | `(*)` is an alias for `mul`.-(*) :: forall a. (Semiring a) => a -> a -> a-(*) = mul--foreign import intAdd :: Int -> Int -> Int-foreign import intMul :: Int -> Int -> Int-foreign import numAdd :: Number -> Number -> Number-foreign import numMul :: Number -> Number -> Number---- | The `Ring` class is for types that support addition, multiplication,--- | and subtraction operations.--- |--- | Instances must satisfy the following law in addition to the `Semiring`--- | laws:--- |--- | - Additive inverse: `a - a = (zero - a) + a = zero`-class (Semiring a) <= Ring a where-  sub :: a -> a -> a--instance ringInt :: Ring Int where-  sub = intSub--instance ringNumber :: Ring Number where-  sub = numSub--instance ringUnit :: Ring Unit where-  sub _ _ = unit--infixl 6 ----- | `(-)` is an alias for `sub`.-(-) :: forall a. (Ring a) => a -> a -> a-(-) = sub---- | `negate x` can be used as a shorthand for `zero - x`.-negate :: forall a. (Ring a) => a -> a-negate a = zero - a--foreign import intSub :: Int -> Int -> Int-foreign import numSub :: Number -> Number -> Number---- | The `ModuloSemiring` class is for types that support addition,--- | multiplication, division, and modulo (division remainder) operations.--- |--- | Instances must satisfy the following law in addition to the `Semiring`--- | laws:--- |--- | - Remainder: `a / b * b + (a `mod` b) = a`-class (Semiring a) <= ModuloSemiring a where-  div :: a -> a -> a-  mod :: a -> a -> a--instance moduloSemiringInt :: ModuloSemiring Int where-  div = intDiv-  mod = intMod--instance moduloSemiringNumber :: ModuloSemiring Number where-  div = numDiv-  mod _ _ = 0.0--instance moduloSemiringUnit :: ModuloSemiring Unit where-  div _ _ = unit-  mod _ _ = unit--infixl 7 /---- | `(/)` is an alias for `div`.-(/) :: forall a. (ModuloSemiring a) => a -> a -> a-(/) = div--foreign import intDiv :: Int -> Int -> Int-foreign import numDiv :: Number -> Number -> Number-foreign import intMod :: Int -> Int -> Int---- | A `Ring` where every nonzero element has a multiplicative inverse.--- |--- | Instances must satisfy the following law in addition to the `Ring` and--- | `ModuloSemiring` laws:--- |--- | - Multiplicative inverse: `(one / x) * x = one`--- |--- | As a consequence of this ```a `mod` b = zero``` as no divide operation--- | will have a remainder.-class (Ring a, ModuloSemiring a) <= DivisionRing a--instance divisionRingNumber :: DivisionRing Number-instance divisionRingUnit :: DivisionRing Unit---- | The `Num` class is for types that are commutative fields.--- |--- | Instances must satisfy the following law in addition to the--- | `DivisionRing` laws:--- |--- | - Commutative multiplication: `a * b = b * a`-class (DivisionRing a) <= Num a--instance numNumber :: Num Number-instance numUnit :: Num Unit---- | The `Eq` type class represents types which support decidable equality.--- |--- | `Eq` instances should satisfy the following laws:--- |--- | - Reflexivity: `x == x = true`--- | - Symmetry: `x == y = y == x`--- | - Transitivity: if `x == y` and `y == z` then `x == z`-class Eq a where-  eq :: a -> a -> Boolean--infix 4 ==-infix 4 /=---- | `(==)` is an alias for `eq`. Tests whether one value is equal to another.-(==) :: forall a. (Eq a) => a -> a -> Boolean-(==) = eq---- | `(/=)` tests whether one value is _not equal_ to another. Shorthand for--- | `not (x == y)`.-(/=) :: forall a. (Eq a) => a -> a -> Boolean-(/=) x y = not (x == y)--instance eqBoolean :: Eq Boolean where-  eq = refEq--instance eqInt :: Eq Int where-  eq = refEq--instance eqNumber :: Eq Number where-  eq = refEq--instance eqChar :: Eq Char where-  eq = refEq--instance eqString :: Eq String where-  eq = refEq--instance eqUnit :: Eq Unit where-  eq _ _ = true--instance eqArray :: (Eq a) => Eq (Array a) where-  eq = eqArrayImpl (==)--instance eqOrdering :: Eq Ordering where-  eq LT LT = true-  eq GT GT = true-  eq EQ EQ = true-  eq _  _  = false--foreign import refEq :: forall a. a -> a -> Boolean-foreign import refIneq :: forall a. a -> a -> Boolean-foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean---- | The `Ordering` data type represents the three possible outcomes of--- | comparing two values:--- |--- | `LT` - The first value is _less than_ the second.--- | `GT` - The first value is _greater than_ the second.--- | `EQ` - The first value is _equal to_ the second.-data Ordering = LT | GT | EQ---- | The `Ord` type class represents types which support comparisons with a--- | _total order_.--- |--- | `Ord` instances should satisfy the laws of total orderings:--- |--- | - Reflexivity: `a <= a`--- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`--- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`-class (Eq a) <= Ord a where-  compare :: a -> a -> Ordering--instance ordBoolean :: Ord Boolean where-  compare = unsafeCompare--instance ordInt :: Ord Int where-  compare = unsafeCompare--instance ordNumber :: Ord Number where-  compare = unsafeCompare--instance ordString :: Ord String where-  compare = unsafeCompare--instance ordChar :: Ord Char where-  compare = unsafeCompare--instance ordUnit :: Ord Unit where-  compare _ _ = EQ--instance ordArray :: (Ord a) => Ord (Array a) where-  compare xs ys = compare 0 $ ordArrayImpl (\x y -> case compare x y of-                                                EQ -> 0-                                                LT -> 1-                                                GT -> -1) xs ys--foreign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int--instance ordOrdering :: Ord Ordering where-  compare LT LT = EQ-  compare EQ EQ = EQ-  compare GT GT = EQ-  compare LT _  = LT-  compare EQ LT = GT-  compare EQ GT = LT-  compare GT _  = GT--infixl 4 <-infixl 4 >-infixl 4 <=-infixl 4 >=---- | Test whether one value is _strictly less than_ another.-(<) :: forall a. (Ord a) => a -> a -> Boolean-(<) a1 a2 = case a1 `compare` a2 of-  LT -> true-  _ -> false---- | Test whether one value is _strictly greater than_ another.-(>) :: forall a. (Ord a) => a -> a -> Boolean-(>) a1 a2 = case a1 `compare` a2 of-  GT -> true-  _ -> false---- | Test whether one value is _non-strictly less than_ another.-(<=) :: forall a. (Ord a) => a -> a -> Boolean-(<=) a1 a2 = case a1 `compare` a2 of-  GT -> false-  _ -> true---- | Test whether one value is _non-strictly greater than_ another.-(>=) :: forall a. (Ord a) => a -> a -> Boolean-(>=) a1 a2 = case a1 `compare` a2 of-  LT -> false-  _ -> true--unsafeCompare :: forall a. a -> a -> Ordering-unsafeCompare = unsafeCompareImpl LT EQ GT--foreign import unsafeCompareImpl :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering---- | The `Bounded` type class represents types that are finite.--- |--- | Although there are no "internal" laws for `Bounded`, every value of `a`--- | should be considered less than or equal to `top` by some means, and greater--- | than or equal to `bottom`.--- |--- | The lack of explicit `Ord` constraint allows flexibility in the use of--- | `Bounded` so it can apply to total and partially ordered sets, boolean--- | algebras, etc.-class Bounded a where-  top :: a-  bottom :: a--instance boundedBoolean :: Bounded Boolean where-  top = true-  bottom = false--instance boundedUnit :: Bounded Unit where-  top = unit-  bottom = unit--instance boundedOrdering :: Bounded Ordering where-  top = GT-  bottom = LT--instance boundedInt :: Bounded Int where-  top = 2147483647-  bottom = -2147483648--instance boundedFn :: (Bounded b) => Bounded (a -> b) where-  top _ = top-  bottom _ = bottom---- | The `BoundedOrd` type class represents totally ordered finite data types.--- |--- | Instances should satisfy the following law in addition to the `Ord` laws:--- |--- | - Ordering: `bottom <= a <= top`-class (Bounded a, Ord a) <= BoundedOrd a--instance boundedOrdBoolean :: BoundedOrd Boolean where-instance boundedOrdUnit :: BoundedOrd Unit where-instance boundedOrdOrdering :: BoundedOrd Ordering where-instance boundedOrdInt :: BoundedOrd Int where---- | The `BooleanAlgebra` type class represents types that behave like boolean--- | values.--- |--- | Instances should satisfy the following laws in addition to the `Bounded`--- | laws:--- |--- | - Associativity:--- |   - `a || (b || c) = (a || b) || c`--- |   - `a && (b && c) = (a && b) && c`--- | - Commutativity:--- |   - `a || b = b || a`--- |   - `a && b = b && a`--- | - Distributivity:--- |   - `a && (b || c) = (a && b) || (a && c)`--- |   - `a || (b && c) = (a || b) && (a || c)`--- | - Identity:--- |   - `a || bottom = a`--- |   - `a && top = a`--- | - Idempotent:--- |   - `a || a = a`--- |   - `a && a = a`--- | - Absorption:--- |   - `a || (a && b) = a`--- |   - `a && (a || b) = a`--- | - Annhiliation:--- |   - `a || top = top`--- | - Complementation:--- |   - `a && not a = bottom`--- |   - `a || not a = top`-class (Bounded a) <= BooleanAlgebra a where-  conj :: a -> a -> a-  disj :: a -> a -> a-  not :: a -> a--instance booleanAlgebraBoolean :: BooleanAlgebra Boolean where-  conj = boolAnd-  disj = boolOr-  not = boolNot--instance booleanAlgebraUnit :: BooleanAlgebra Unit where-  conj _ _ = unit-  disj _ _ = unit-  not _ = unit--instance booleanAlgebraFn :: (BooleanAlgebra b) => BooleanAlgebra (a -> b) where-  conj fx fy a = fx a `conj` fy a-  disj fx fy a = fx a `disj` fy a-  not fx a = not (fx a)--infixr 3 &&-infixr 2 ||---- | `(&&)` is an alias for `conj`.-(&&) :: forall a. (BooleanAlgebra a) => a -> a -> a-(&&) = conj---- | `(||)` is an alias for `disj`.-(||) :: forall a. (BooleanAlgebra a) => a -> a -> a-(||) = disj--foreign import boolOr :: Boolean -> Boolean -> Boolean-foreign import boolAnd :: Boolean -> Boolean -> Boolean-foreign import boolNot :: Boolean -> Boolean---- | The `Show` type class represents those types which can be converted into--- | a human-readable `String` representation.--- |--- | While not required, it is recommended that for any expression `x`, the--- | string `show x` be executable PureScript code which evaluates to the same--- | value as the expression `x`.-class Show a where-  show :: a -> String--instance showBoolean :: Show Boolean where-  show true = "true"-  show false = "false"--instance showInt :: Show Int where-  show = showIntImpl--instance showNumber :: Show Number where-  show = showNumberImpl--instance showChar :: Show Char where-  show = showCharImpl--instance showString :: Show String where-  show = showStringImpl--instance showUnit :: Show Unit where-  show _ = "unit"--instance showArray :: (Show a) => Show (Array a) where-  show = showArrayImpl show--instance showOrdering :: Show Ordering where-  show LT = "LT"-  show GT = "GT"-  show EQ = "EQ"--foreign import showIntImpl :: Int -> String-foreign import showNumberImpl :: Number -> String-foreign import showCharImpl :: Char -> String-foreign import showStringImpl :: String -> String-foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String

@@ -1,27 +0,0 @@-/* global exports */-"use strict";--// module Test.Assert--exports["assert'"] = function (message) {-  return function (success) {-    return function () {-      if (!success) throw new Error(message);-      return {};-    };-  };-};--exports.checkThrows = function (fn) {-  return function () {-    try {-      fn();-      return false;-    } catch (e) {-      if (e instanceof Error) return true;-      var err = new Error("Threw something other than an Error");-      err.something = e;-      throw err;-    }-  };-};

@@ -1,46 +0,0 @@-module Test.Assert-  ( assert'-  , assert-  , assertThrows-  , assertThrows'-  , ASSERT()-  ) where--import Control.Monad.Eff (Eff())-import Prelude---- | Assertion effect type.-foreign import data ASSERT :: !---- | Throws a runtime exception with message "Assertion failed" when the boolean--- | value is false.-assert :: forall e. Boolean -> Eff (assert :: ASSERT | e) Unit-assert = assert' "Assertion failed"---- | Throws a runtime exception with the specified message when the boolean--- | value is false.-foreign import assert' :: forall e. String -> Boolean -> Eff (assert :: ASSERT | e) Unit---- | Throws a runtime exception with message "Assertion failed: An error should--- | have been thrown", unless the argument throws an exception when evaluated.--- |--- | This function is specifically for testing unsafe pure code; for example,--- | to make sure that an exception is thrown if a precondition is not--- | satisfied. Functions which use `Eff (err :: EXCEPTION | eff) a` can be--- | tested with `catchException` instead.-assertThrows :: forall e a. (Unit -> a) -> Eff (assert :: ASSERT | e) Unit-assertThrows = assertThrows' "Assertion failed: An error should have been thrown"---- | Throws a runtime exception with the specified message, unless the argument--- | throws an exception when evaluated.--- |--- | This function is specifically for testing unsafe pure code; for example,--- | to make sure that an exception is thrown if a precondition is not--- | satisfied. Functions which use `Eff (err :: EXCEPTION | eff) a` can be--- | tested with `catchException` instead.-assertThrows' :: forall e a. String -> (Unit -> a) -> Eff (assert :: ASSERT | e) Unit-assertThrows' msg fn =-  checkThrows fn >>= assert' msg---foreign import checkThrows :: forall e a. (Unit -> a) -> Eff (assert :: ASSERT | e) Boolean

@@ -0,0 +1,7 @@+{+  "private": true,+  "dependencies": {+    "bower": "^1.4.1",+    "glob": "^5.0.14"+  }+}

@@ -0,0 +1,22 @@+var glob = require("glob");+var fs = require("fs");++try {+  fs.mkdirSync("./flattened");+} catch(e) {+  // ignore the error if it already exists+  if (e.code !== "EEXIST") {+    throw(e);+  }+}++glob("bower_components/*/src/**/*.{js,purs}", function(err, files) {+  if (err) throw err;+  files.forEach(function(file) {+    // We join with "-" because Cabal is weird about file extensions.+    var dest = "./flattened/" + file.split("/").slice(3).join("-");+    console.log("Copying " + file + " to " + dest);+    var content = fs.readFileSync(file, "utf-8");+    fs.writeFileSync(dest, content, "utf-8");+  });+})