packages feed

apiary-purescript (empty) → 0.14.0

raw patch · 6 files changed

+229/−0 lines, 6 filesdep +Globdep +apiarydep +basesetup-changed

Dependencies added: Glob, apiary, base, bytestring, filepath, parsec, purescript, reflection, template-haskell, text, unordered-containers, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ apiary-purescript.cabal view
@@ -0,0 +1,42 @@+name:                apiary-purescript+version:             0.14.0+synopsis:            purescript compiler for apiary web framework.+description:+  example: <https://github.com/philopon/apiary/blob/master/examples/pureScript.hs>+license:             MIT+license-file:        LICENSE+author:              HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer:          HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage:            https://github.com/philopon/apiary+Bug-reports:         https://github.com/philopon/apiary/issues+copyright:           (c) 2014 Hirotomo Moriwaki+category:            Web+build-type:          Simple+stability:           experimental+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Web.Apiary.PureScript+                       Web.Apiary.PureScript.Explicit+  other-modules:       Web.Apiary.PureScript.Internal+  build-depends:       base                 >=4.6   && <4.8+                     , template-haskell+                     , apiary               >=0.14  && <0.15+                     , purescript           >=0.5   && <0.6+                     , filepath             >=1.3   && <1.4+                     , utf8-string          >=0.3   && <0.4+                     , text                 >=1.1   && <1.2+                     , bytestring           >=0.10  && <0.11+                     , unordered-containers >=0.2   && <0.3+                     , reflection           >=1.4   && <1.6+                     , parsec               >=3.1   && <3.2+                     , Glob                 >=0.7   && <0.8++  hs-source-dirs:      src+  ghc-options:         -O2 -Wall+  default-language:    Haskell2010++source-repository head+  type:     git+  location: git://github.com/philopon/apiary.git
+ src/Web/Apiary/PureScript.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}++module Web.Apiary.PureScript+    ( I.PureScriptConfig(..)+    , HasPureScript+    , withPureScript+    , pureScript+    ) where++import Web.Apiary+import qualified Web.Apiary.PureScript.Internal as I+import Data.Reflection++type HasPureScript = Given I.PureScript++withPureScript :: MonadIO m => I.PureScriptConfig+               -> (HasPureScript => m a) -> m a+withPureScript conf m = I.withPureScript conf $ \p -> give p m++pureScript :: (MonadIO m, HasPureScript) => FilePath -> ActionT m ()+pureScript = I.pureScript given
+ src/Web/Apiary/PureScript/Explicit.hs view
@@ -0,0 +1,8 @@+module Web.Apiary.PureScript.Explicit+    ( PureScriptConfig(..)+    , PureScript+    , withPureScript+    , pureScript+    ) where++import Web.Apiary.PureScript.Internal
+ src/Web/Apiary/PureScript/Internal.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.Apiary.PureScript.Internal where++import System.FilePath+import qualified System.FilePath.Glob as G+import qualified System.IO.UTF8 as U++import Language.Haskell.TH+import qualified Language.PureScript as P++import Control.Exception+import Control.Applicative++import Web.Apiary++import Data.IORef+import Data.Typeable+import qualified Data.HashMap.Strict as H+import qualified Text.Parsec.Error as P+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as T+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as LC++import qualified Paths_apiary_purescript as Path++data PureScriptException+    = ParseError   P.ParseError+    | CompileError String+    deriving (Show, Typeable)+instance Exception PureScriptException++purescriptDatadir :: FilePath+purescriptDatadir = takeDirectory $(stringE =<< runIO Path.getDataDir) </> "purescript-" ++ VERSION_purescript++defaultPatterns :: [G.Pattern]+defaultPatterns = map G.compile +    [ "src/**/*.purs"+    , "bower_components/purescript-*/src/**/*.purs"+    , "bower_components/purescript-*/src/**/*.purs.hs"+    ]++data PureScriptConfig = PureScriptConfig+    { libraryPatterns   :: [G.Pattern]+    , libraryBaseDir    :: FilePath+    , preludePath       :: FilePath+    , development       :: Bool+    , initialCompiles   :: [FilePath]+    , pureScriptOptions :: P.Options+    }++instance Default PureScriptConfig where+    def = PureScriptConfig +        defaultPatterns+        "."+        defaultPreludePath+        False+        []+        P.defaultOptions+        { P.optionsMain             = Just "Main"+        , P.optionsBrowserNamespace = Just "PS"+        }++data PureScript = PureScript+    { pscConfig :: PureScriptConfig+    , compiled  :: IORef (H.HashMap FilePath L.ByteString)+    }++withPureScript :: MonadIO m => PureScriptConfig -> (PureScript -> m b) -> m b+withPureScript conf m = do+    ir <- liftIO $ mapM (\p -> (p,) <$> compile conf p) (initialCompiles conf)+    p  <- liftIO $ PureScript conf <$> newIORef (H.fromList ir)+    m p++defaultPreludePath :: FilePath+defaultPreludePath = purescriptDatadir </> "prelude/prelude.purs"++readPscInput :: FilePath -> IO [P.Module]+readPscInput p = do+    txt <- U.readFile p+    case P.runIndentParser p P.parseModules txt of+        Left e  -> throwIO $ ParseError e+        Right r -> return r++pscModules :: PureScriptConfig -> IO [P.Module]+pscModules conf = do+    mods <- liftIO $ do+        concat . fst <$> G.globDir (libraryPatterns conf) (libraryBaseDir conf)+    let prel = preludePath conf+    concat `fmap` mapM readPscInput (prel : mods)++compile :: PureScriptConfig -> FilePath -> IO L.ByteString+compile opt p = do+    mods <- pscModules opt+    mn   <- readPscInput p+    case P.compile (pureScriptOptions opt) $ mn ++ mods of+        Left l           -> throwIO (CompileError l)+        Right (js, _, _) -> return . T.encodeUtf8 $ T.pack js++pureScript :: MonadIO m => PureScript -> FilePath -> ActionT m ()+pureScript env p = do+    contentType "text/javascript"+    s <- liftIO . try $ +        if development (pscConfig env)+        then compile (pscConfig env) p+        else (H.lookup p <$> readIORef (compiled env)) >>= \case+           Nothing -> do+               r <- compile (pscConfig env) p+               atomicModifyIORef' (compiled env) ((,()) . H.insert p r)+               return r+           Just r  -> return r+    case s of+        Right r -> lbs r+        Left  e | development (pscConfig env) -> +            lbs . LC.pack $ "alert(\"" ++ pr (e::PureScriptException) ++ "\")"++                | otherwise -> lbs "alert(\"PureScript error.\");"+  where+    pr = concatMap esc . show+    esc '"'  = "\\\""+    esc '\'' = "\\'"+    esc '\\' = "\\\\"+    esc '/'  = "\\/"+    esc '<'  = "\\x3c"+    esc '>'  = "\\x3e"+    esc '\n' = "\\n"+    esc c    = [c]