git.haldean.org del / 338be91
import from HTTP source Haldean Brown 2 years ago
2 changed file(s) with 24 addition(s) and 8 deletion(s). Raw diff Collapse all Expand all
0 (import sphere.del s)
1
2 (* (import http://git.haldean.org/del/raw/master/examples/sphere.del s) *)
0 (import http://git.haldean.org/del/raw/master/examples/sphere.del s)
31
42 (define root:color (v:f3)
53 (if (< (s.sphere 1.0 v) 0.001)
0 {-# OPTIONS_GHC -fno-warn-orphans #-}
1
02 module Language.Del.Imports (collectImports, defaultImportEnv) where
13
4 import Control.Exception (throwIO)
25 import Control.Monad
36 import Data.List.Split
47 import qualified Data.Map.Strict as Map
58 import Data.Set
69 import qualified Data.Text as T
10 import Data.Text.Encoding
711 import Language.Del.AST
812 import Language.Del.AstUtils
913 import Language.Del.CompileDefs
1014 import Language.Del.Load
1115 import qualified Language.Del.Reader as R
16 import Network.HTTP.Req
1217 import System.Directory
1318 import System.Environment
1419 import System.FilePath
20
21 instance MonadHttp IO where
22 handleHttpException = throwIO
1523
1624 data ImportEnv = ImportEnv [FilePath] deriving (Show, Eq)
1725
5563 findSourceFile :: ImportEnv -> T.Text -> IO (Maybe FilePath)
5664 findSourceFile (ImportEnv dirs) base = mapM (fileInDir $ T.unpack base) dirs >>= return . msum
5765
66 fromForms :: Artifact [R.Form] -> Artifact AST
67 fromForms (Success fs) = Success (buildAST fs)
68 fromForms (Failure e) = Failure e
69
5870 loadImport :: ImportEnv -> Source -> IO (Artifact AST)
59 loadImport _ (Right _) = error "URL imports not yet supported"
71
72 loadImport _ (Right (HttpsSource url)) = do
73 putStrLn $ "loading source from " ++ show url
74 res <- req GET url NoReqBody bsResponse mempty
75 return $ fromForms (R.read $ decodeUtf8 $ responseBody res)
76 loadImport _ (Right (HttpSource url)) = do
77 putStrLn $ "loading source from " ++ show url
78 res <- req GET url NoReqBody bsResponse mempty
79 return $ fromForms (R.read $ decodeUtf8 $ responseBody res)
80
6081 loadImport env s@(Left name) =
6182 findSourceFile env name >>= \path -> case path of
6283 Nothing -> return $ Failure (BadImport s)
6384 Just p -> do
6485 contents <- readFile p >>= return . T.pack
65 let forms = R.read contents
66 case forms of
67 Success f -> return $ Success (buildAST f)
68 Failure e -> return $ Failure e
86 return $ fromForms (R.read contents)
6987
7088 collectImports :: ImportEnv -> [Source] -> AST -> IO (Artifact AST)
7189 collectImports env loaded (AST m ((Import src alias):xs)) =