Skip to content

Commit b91ca3a

Browse files
paf31paf31
committed
Embed prelude in code to avoid loading file from filesystem
1 parent d58a69f commit b91ca3a

File tree

3 files changed

+153
-266
lines changed

3 files changed

+153
-266
lines changed

‎Main.hs

Lines changed: 153 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -34,10 +34,6 @@ import Text.Blaze.Html
3434
import Text.Blaze.Html.Renderer.Text
3535
import qualified Text.Blaze.Html5 as H
3636
import qualified Text.Blaze.Html5.Attributes as A
37-
import qualified Paths_trypurescript as Paths
38-
39-
getPreludeFilename :: IO FilePath
40-
getPreludeFilename = Paths.getDataFileName "prelude.purs"
4137

4238
data Compiled = Compiled { js :: String
4339
, externs :: String
@@ -50,11 +46,6 @@ options = P.defaultOptions { P.optionsTco = True
5046
, P.optionsMagicDo = True
5147
, P.optionsModules = ["Main"] }
5248

53-
loadModule :: FilePath -> IO (Either String [P.Module])
54-
loadModule moduleFile = do
55-
moduleText <- readFile moduleFile
56-
return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
57-
5849
compile :: [P.Module] -> String -> IO Response
5950
compile _ input | length input > 5000 = return $ Response $ Left "Please limit your input to 5000 characters"
6051
compile prelude input = do
@@ -74,6 +65,156 @@ str = id
7465
mono :: H.Html -> H.Html
7566
mono h = h ! A.class_ "mono"
7667

68+
prelude :: String
69+
prelude = unlines
70+
[
71+
"module Prelude where",
72+
"",
73+
"infixr 0 $",
74+
"",
75+
"($) :: forall a b. (a -> b) -> a -> b",
76+
"($) f x = f x",
77+
"",
78+
"class Monad m where",
79+
" ret :: forall a. a -> m a",
80+
" (>>=) :: forall a b. m a -> (a -> m b) -> m b",
81+
"",
82+
"infixl 7 *",
83+
"infixl 7 /",
84+
"infixl 7 %",
85+
"",
86+
"infixl 6 -",
87+
"infixl 6 +",
88+
"",
89+
"class Num a where",
90+
" (+) :: a -> a -> a",
91+
" (-) :: a -> a -> a",
92+
" (*) :: a -> a -> a",
93+
" (/) :: a -> a -> a",
94+
" (%) :: a -> a -> a",
95+
" negate :: a -> a",
96+
"",
97+
"foreign import numAdd :: Number -> Number -> Number",
98+
"foreign import numSub :: Number -> Number -> Number",
99+
"foreign import numMul :: Number -> Number -> Number",
100+
"foreign import numDiv :: Number -> Number -> Number",
101+
"foreign import numMod :: Number -> Number -> Number",
102+
"foreign import numNegate :: Number -> Number",
103+
"",
104+
"instance Num Number where",
105+
" (+) = numAdd",
106+
" (-) = numSub",
107+
" (*) = numMul",
108+
" (/) = numDiv",
109+
" (%) = numMod",
110+
" negate = numNegate",
111+
"",
112+
"infixl 4 ==",
113+
"infixl 4 /=",
114+
"",
115+
"class Eq a where",
116+
" (==) :: a -> a -> Boolean",
117+
" (/=) :: a -> a -> Boolean",
118+
"",
119+
"foreign import unsafeRefEq :: forall a. a -> a -> Boolean",
120+
"foreign import unsafeRefIneq :: forall a. a -> a -> Boolean",
121+
"",
122+
"instance Eq String where",
123+
" (==) = unsafeRefEq",
124+
" (/=) = unsafeRefIneq",
125+
"",
126+
"instance Eq Number where",
127+
" (==) = unsafeRefEq",
128+
" (/=) = unsafeRefIneq",
129+
"",
130+
"instance Eq Boolean where",
131+
" (==) = unsafeRefEq",
132+
" (/=) = unsafeRefIneq",
133+
"",
134+
"instance (Eq a) => Eq [a] where",
135+
" (==) [] [] = true",
136+
" (==) (x:xs) (y:ys) = x == y && xs == ys",
137+
" (==) _ _ = false",
138+
" (/=) xs ys = not (xs == ys)",
139+
"",
140+
"infixl 4 <",
141+
"infixl 4 >",
142+
"infixl 4 <=",
143+
"infixl 4 >=",
144+
"",
145+
"class Ord a where",
146+
" (<) :: a -> a -> Boolean",
147+
" (>) :: a -> a -> Boolean",
148+
" (<=) :: a -> a -> Boolean",
149+
" (>=) :: a -> a -> Boolean",
150+
"",
151+
"foreign import numLess :: Number -> Number -> Boolean",
152+
"foreign import numLessEq :: Number -> Number -> Boolean",
153+
"foreign import numGreater :: Number -> Number -> Boolean",
154+
"foreign import numGreaterEq :: Number -> Number -> Boolean",
155+
"",
156+
"instance Ord Number where",
157+
" (<) = numLess",
158+
" (>) = numGreater",
159+
" (<=) = numLessEq",
160+
" (>=) = numGreaterEq",
161+
"",
162+
"infixl 10 &",
163+
"infixl 10 |",
164+
"infixl 10 ^",
165+
"",
166+
"class Bits b where",
167+
" (&) :: b -> b -> b",
168+
" (|) :: b -> b -> b",
169+
" (^) :: b -> b -> b",
170+
" shl :: b -> Number -> b",
171+
" shr :: b -> Number -> b",
172+
" zshr :: b -> Number -> b",
173+
" complement :: b -> b",
174+
"",
175+
"foreign import numShl :: Number -> Number -> Number",
176+
"foreign import numShr :: Number -> Number -> Number",
177+
"foreign import numZshr :: Number -> Number -> Number",
178+
"foreign import numAnd :: Number -> Number -> Number",
179+
"foreign import numOr :: Number -> Number -> Number",
180+
"foreign import numXor :: Number -> Number -> Number",
181+
"foreign import numComplement :: Number -> Number",
182+
"",
183+
"instance Bits Number where",
184+
" (&) = numAnd",
185+
" (|) = numOr",
186+
" (^) = numXor",
187+
" shl = numShl",
188+
" shr = numShr",
189+
" zshr = numZshr",
190+
" complement = numComplement",
191+
"",
192+
"infixl 8 !!",
193+
"",
194+
"foreign import (!!) :: forall a. [a] -> Number -> a",
195+
"",
196+
"infixr 2 ||",
197+
"infixr 3 &&",
198+
"",
199+
"class BoolLike b where",
200+
" (&&) :: b -> b -> b",
201+
" (||) :: b -> b -> b",
202+
" not :: b -> b",
203+
"",
204+
"foreign import boolAnd :: Boolean -> Boolean -> Boolean",
205+
"foreign import boolOr :: Boolean -> Boolean -> Boolean",
206+
"foreign import boolNot :: Boolean -> Boolean",
207+
"",
208+
"instance BoolLike Boolean where",
209+
" (&&) = boolAnd",
210+
" (||) = boolOr",
211+
" not = boolNot",
212+
"",
213+
"infixr 5 ++",
214+
"",
215+
"foreign import (++) :: String -> String -> String"
216+
]
217+
77218
examplesJs :: String
78219
examplesJs = unlines
79220
[ "$('#examples').change(function() {"
@@ -389,8 +530,7 @@ responseToJs (Just (Response (Right (Compiled js _)))) = (True, js)
389530

390531
server :: Int -> IO ()
391532
server port = do
392-
preludeFilename <- getPreludeFilename
393-
Right prelude <- loadModule preludeFilename
533+
let preludeModules = either (error . show) id $ P.runIndentParser "" P.parseModules prelude
394534
scotty port $ do
395535
get "/" $ do
396536
page Nothing (Just "-- Type PureScript code here and click 'Compile' ...\r\n-- \r\n-- Or select an example from the list at the top right of the page") Nothing
@@ -399,11 +539,11 @@ server port = do
399539
case lookup name examples of
400540
Nothing -> raise "No such example"
401541
Just (_, code) -> do
402-
response <- lift $ compile prelude code
542+
response <- lift $ compile preludeModules code
403543
page (Just name) (Just code) (Just response)
404544
post "/compile" $ do
405545
code <- param "code"
406-
response <- lift $ compile prelude code
546+
response <- lift $ compile preludeModules code
407547
page Nothing (Just code) (Just response)
408548

409549
term :: Term (IO ())

0 commit comments

Comments
 (0)