Commit 2c2163d8 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Add a 'resource' mount type to incorporate arbitrary external files to a...

Add a 'resource' mount type to incorporate arbitrary external files to a build, as Curly values of type #bytes
parent e73c9a34
......@@ -306,6 +306,8 @@ data Builtin = B_Undefined
| B_StringLength
| B_AddString | B_ShowInt
| B_Bytes Bytes
| B_MkArray
| B_ArrayLength
| B_ArrayAt
......
......@@ -62,7 +62,7 @@ evalDocWithPatterns pats vars = eval
evalDoc :: DocParams -> Documentation -> Maybe Documentation
evalDoc = evalDocWithPatterns zero
nodoc = Join (DocTag "nodoc" [] [])
nodoc msg = Join (DocTag "nodoc" [] [Pure msg])
mkDoc d = Join . DocTag "doc" [] $ fromMaybe [] $ matches Just (between spc spc (sepBy' docAtom spc)) d
spc :: (ParseStream c s, ParseToken c, TokenPayload c ~ Char,Monad m) => ParserT s m ()
spc = skipMany' (oneOf " \t\n")
......@@ -211,14 +211,15 @@ docString trm stl d = getId ((doc' d^..i'RWST) ((),(BeginP,zero,0))) & \(_,_,t)
unless isSet $ do
l'2.l'1 =- True
maybe unit setDisplay bl
indent
maybe unit (\pre -> tell pre >> (l'2.l'2.tagPrefix =- Nothing)) p
tell (restoreDefaultColors trm)
maybe unit (tell . setForegroundColor trm) cf
maybe unit (tell . setBackgroundColor trm) cb
boolSt bo (tell $ setBold trm True)
boolSt u (tell $ setUnderlined trm True)
boolSt it (tell $ setItalic trm True)
indent
maybe unit (\pre -> tell pre >> (l'2.l'2.tagPrefix =- Nothing)) p
styleEnd = do
(isSet,TagStyle (fg,bg) bl bo u it _ _) <- getl l'2
when isSet $ do
......
......@@ -6,7 +6,7 @@ module Curly.Core.Library(
atM,atMs,fromPList,
-- ** Leaves
ModLeaf,SourcePos,SourceRange(..),
undefLeaf,leafVal,leafDoc,leafPos,leafType,leafIsMethod,
undefLeaf,undefSymLeaf,leafVal,leafDoc,leafPos,leafType,leafIsMethod,
-- * Libraries
GlobalID(..),
LibraryID(..),isLibData,
......@@ -277,7 +277,8 @@ type LibRep s = (Metadata,Module s
scoped :: Iso' Library (LibRep GlobalID)
scoped = iso f g
where f (Library syn i s es is e) = (syn,map fst i,map2 toExpr s,es,map2 toExpr (filterInsts is),instDeps,map fst e)
where toSym (s,Pure sym) = (s,Just sym)
where toSym (s@(GlobalID _ (Just _)),Pure (Builtin _ (B_Bytes _))) = (s,Nothing)
toSym (s,Pure sym) = (s,Just sym)
toSym (s,_) = (s,Nothing)
toExpr = map toSym . c'Expression . semantic
......@@ -285,8 +286,8 @@ scoped = iso f g
instDeps = c'set $ fromKList [k | (Just k,_) <- toList is]
g (syn,i',s',es,is',isd,e') = Library syn i s es is e
where symVal (GlobalID _ (Just (s,l))) = fromMaybe (error $ "Couldn't find library "+show l) (findLib l)
^.flLibrary.symbols.at s.l'Just undefLeaf
symVal (GlobalID i Nothing) = s^.at i.l'Just undefLeaf
^.flLibrary.symbols.at s.l'Just (undefSymLeaf s (Just l))
symVal (GlobalID i Nothing) = s^.at i.l'Just (undefLeaf (format "Undefined local symbol %s" i))
fromSym (s,Just sym) = (s,Pure sym)
fromSym (s,Nothing) = (s,Join (symVal s^.leafVal))
fromExpr = withType . map (_rawNameExpr . semantic . c'Expression . map fromSym)
......@@ -353,14 +354,17 @@ flSource :: Lens' FileLibrary (Maybe String)
flSource = lens _flSource (\x y -> x { _flSource = y })
type Mountain = Module FileLibrary
mapIdents :: (String -> GlobalID -> GlobalID) -> (GlobalID -> GlobalID) -> Context -> Context
mapIdents sw f = mapC ""
withPrevIdents :: String -> Module a -> Module (String,a)
withPrevIdents p (Pure a) = Pure (p,a)
withPrevIdents _ (Join (ModDir d)) = Join (ModDir [(s,withPrevIdents s x) | (s,x) <- d])
mapIdents :: (String -> GlobalID -> GlobalID) -> (GlobalID -> GlobalID) -> String -> Context -> Context
mapIdents sw f = mapC
where mapDE = warp (leafType.ff'idents) f . warp leafVal mapE
mapE = warp (from i'NameNode) (map (first f)) . warp (t'exprType.ff'idents) f
mapC _ (Join (ModDir m)) = Join . ModDir $ warp each (\(s,e) -> (s,mapC s e)) m
mapC s (Pure (i,e)) = Pure (sw s (f i),mapDE e)
context :: Mountain -> Context
context m = m >>= \fl -> mapIdents (\s (GlobalID _ l) -> GlobalID s l) (setId (fl^.flID)) (fl^.flLibrary.exports)
context m = withPrevIdents "" m >>= \(n,fl) -> mapIdents (\s (GlobalID _ l) -> GlobalID s l) (setId (fl^.flID)) n (fl^.flLibrary.exports)
where setId i (GlobalID n Nothing) = GlobalID n (Just (n,i))
setId _ x = x
localContext :: (?mountain :: Mountain) => Context
......@@ -368,8 +372,11 @@ localContext = context ?mountain
undefSym :: NameExpr GlobalID
undefSym = mkSymbol (pureIdent "undefined",Pure (Builtin (builtinType B_Undefined) B_Undefined))
undefLeaf :: LeafExpr GlobalID
undefLeaf = ModLeaf nodoc NoRange zero False undefSym
undefLeaf :: String -> LeafExpr GlobalID
undefLeaf msg = ModLeaf (nodoc msg) NoRange zero False undefSym
undefSymLeaf :: String -> Maybe LibraryID -> LeafExpr GlobalID
undefSymLeaf s ml = undefLeaf (format "Undocumented symbol %s%s" s (case ml of Just l -> format " in %s" (show l)
Nothing -> ""))
addImport :: Context -> Library -> Library
addImport imp = warp imports (+imp) . warp symbols (fromAList (map2 snd newSyms)+)
......@@ -379,13 +386,13 @@ addImport imp = warp imports (+imp) . warp symbols (fromAList (map2 snd newSyms)
resolve :: Library -> Module String -> Context
resolve l e = map go e
where go n = (fromMaybe (pureIdent n) (l^.externalSyms.at n),
fromMaybe undefLeaf (l^.symbols.at n))
fromMaybe (undefSymLeaf n Nothing) (l^.symbols.at n))
addExport :: Module String -> Library -> Library
addExport e l = l & exports %~ (+resolve l e)
setExports :: Module String -> Library -> Library
setExports e l = l & exports %- resolve l e
defSymbol :: Semantic e String (String,Maybe (NameExpr GlobalID)) => String -> SourceRange -> Maybe (Type GlobalID) -> Bool -> e -> Library -> Library
defSymbol s r t isM e l = l & symbols.at s.l'Just undefLeaf %~ set leafType tp . set leafVal e' . set leafPos r . set leafIsMethod isM
defSymbol s r t isM e l = l & symbols.at s.l'Just (undefSymLeaf s Nothing) %~ set leafType tp . set leafVal e' . set leafPos r . set leafIsMethod isM
where e' = optExprIn l e
tp = fromMaybe (exprType e') t
......@@ -404,7 +411,7 @@ optExprIn :: Semantic e String (String,Maybe (NameExpr GlobalID)) => Library ->
optExprIn l e = optimize (pureIdent . pretty) (solveConstraints (map (\(_,lf) -> (lf^.leafType,lf^.leafVal)) (l^.implicits)) (exprIn l e))
descSymbol :: String -> Documentation -> Library -> Library
descSymbol s d l = l & symbols.at s.l'Just undefLeaf.leafDoc %- d
descSymbol s d l = l & symbols.at s.l'Just (undefSymLeaf s Nothing).leafDoc %- d
libSymbol :: Library -> GlobalID -> Maybe (LeafExpr GlobalID)
libSymbol l (GlobalID i Nothing) = l^.symbols.at i
......@@ -424,7 +431,7 @@ builtinsLib = let blib = zero
safeLast _ (h:t) = safeLast h t
builtinsMod = fromPList (map2 Pure allBuiltins)
allBuiltins = [
(["undefined"],(pureIdent "undefined",undefLeaf)),
(["undefined"],(pureIdent "undefined",(undefLeaf "Undefined value"))),
(["seq"],mkBLeaf "seq" B_Seq seqDoc),
(["unit"],mkBLeaf "unit" B_Unit unitDoc),
(["file","open"],mkBLeaf "open" B_Open openDoc),
......@@ -455,7 +462,7 @@ builtinsLib = let blib = zero
(["syntax","mkExprSym"],mkBLeaf "mkExprSym" B_ExprSym mkExprSymDoc),
(["syntax","exprInd"],mkBLeaf "exprInd" B_ExprInd exprIndDoc)
]
where mkBLeaf n b d = (pureIdent n,undefLeaf & leafVal %- mkSymbol (pureIdent n,Pure (Builtin (builtinType b) b)) & leafDoc %- mkDoc d)
where mkBLeaf n b d = (pureIdent n,undefLeaf "" & leafVal %- mkSymbol (pureIdent n,Pure (Builtin (builtinType b) b)) & leafDoc %- mkDoc d)
seqDoc = unlines [
"{section {title Sequence Expressions}",
" {p {em Usage:} seq x y}",
......
......@@ -440,7 +440,7 @@ defAccessors syms = do
exprType $ exprIn l (e :: SourceExpr)
lift (l'library =~ mod)
defTypeSym n isM rng tp e = symbols.at n.l'Just undefLeaf %~
defTypeSym n isM rng tp e = symbols.at n.l'Just (undefSymLeaf n Nothing) %~
set leafVal (set t'exprType tp (_rawNameExpr e))
. set leafPos rng
. set leafType tp . set leafIsMethod isM
......
......@@ -444,6 +444,7 @@ builtinType b = (zero :: Type s) & i'typeRel %~ case b of
(B_Number _) -> ln' [] intT
(B_String _) -> ln' [] stringT
(B_Bytes _) -> ln' [] stringT
B_Unit -> ln' [] unitT
B_FileDesc _ -> ln' [] fileT
......
......@@ -317,6 +317,12 @@ assemblyBuiltin encodeWord (B_String s) = Just $ do
tell $ encodeWord (fromIntegral (length s))
for_ s $ tell . binaryCode (Just 1,1)
globalBuiltin global_constant (toValue str)
assemblyBuiltin encodeWord (B_Bytes bs) = Just $ do
str <- inSection DataSection $ getCounter <* do
tell $ encodeWord 1
tell $ encodeWord (fromIntegral (bytesSize bs))
tell $ bytesCode' bs
globalBuiltin global_constant (toValue str)
assemblyBuiltin _ B_MkArray = Just $ getOrDefineBuiltin0 TextSection "mkArray" $ do
[size] <- builtinArgs 1
tmpReg <-- size
......
......@@ -2,10 +2,12 @@
function C.curly() {
local -a CURLY_COMP_SCRIPTS=( )
local which_curly="$(which "${COMP_PROGRAM/icy/curly}")"
case "$which_curly" in
/usr/bin/*) ;;
*) CURLY_COMP_SCRIPTS=( "$which_curly" );;
esac
if file "$which_curly" | grep -q text; then
CURLY_COMP_SCRIPTS+=( "$which_curly" )
fi
if file .curly | grep -q text; then
CURLY_COMP_SCRIPTS+=( .curly )
fi
C.repeat C.curly.arg
}
C.curly "$@"
......@@ -10,8 +10,8 @@ function C.curly.init() {
COMP_DESCRIPTIONS["curly:$short"]="$desc"; fi
if [ "${long:+x}" = x ]; then
COMP_DESCRIPTIONS["curly:$long"]="$desc"; fi
done < <(/usr/bin/curly -h | tail -n +2 | sed -rn 's/^\s+(-[^-])?\s+(--\S+)\s+(\S+)\s+(.*\S)\s*$/\1|\2|\3|\4/p')
IFS=', ' CURLY_SYSTEMS=( $(/usr/bin/curly -h | sed -n 's/^Known systems: //p') ) IFS="$IFSBAK"
done < <(CURLY_VCS=dummy /usr/bin/curly -h | tail -n +2 | sed -rn 's/^\s+(-[^-])?\s+(--\S+)\s+(\S+)\s+(.*\S)\s*$/\1|\2|\3|\4/p')
IFS=', ' CURLY_SYSTEMS=( $(CURLY_VCS=dummy /usr/bin/curly -h | sed -n 's/^Known systems: //p') ) IFS="$IFSBAK"
}
function C.curly.flags() {
C.curly.init
......@@ -30,6 +30,7 @@ function CF.cyscript() {
local hd
read -r hd < "$1"
[[ "$hd" == '#!/usr/bin/curly'*
|| "$hd" == '#!/usr/bin/env curly'*
|| "$hd" == "#!/lib/cyl!#"*
|| "$hd" == "module"*
|| "$hd" == "symbol"* ]]
......@@ -93,8 +94,13 @@ function C.curly.isHash() {
local arg="$1" ; shift
: ${CURLY_LIBCACHE:=$HOME/.curly/libraries}
if C.leaf; then
IFSBAK="$IFS" IFS=$'\n' SUGGESTIONS=( $({ /usr/bin/curly -l'l"{$ synopsis}{or " (v{$ version})" ""}"'; for i in $(ls "$CURLY_LIBCACHE" 2> /dev/null); do hash="${i%.cyl}"; head="$(head -1 "$CURLY_LIBCACHE/$i")"; echo "${head/##!*!#/$hash}"; done; } \
| sort -u | sed -rn "s/^($arg\\S+)\\s*(.*)\$/\\1 -- \\2/p") ) IFS="$IFSBAK"
IFSBAK="$IFS" IFS=$'\n' \
SUGGESTIONS=( $({ /usr/bin/curly -l'l"{$ synopsis}{or " (v{$ version})" ""}"'
for i in $(ls "$CURLY_LIBCACHE" 2> /dev/null); do
hash="${i%.cyl}"; head="$(head -1 "$CURLY_LIBCACHE/$i")"
echo "${head/##!*!#/$hash}"
done; } \
| sort -u | sed -rn "s/^($arg\\S+)\\s*(.*)\$/\\1 -- \\2/p") ) IFS="$IFSBAK"
else
SUGGESTIONS=( "$arg -- " )
fi
......@@ -137,7 +143,7 @@ function C.curly.arg() {
for ((i=0;i<${#compFlags[@]};i++)); do
compFlags[i]+=" -- ${compFlagDescs[${compFlags[i]}]}"
done
} < <(/usr/bin/curly "${CURLY_COMP_SCRIPTS[@]}" -h)
} < <(CURLY_VCS=dummy /usr/bin/curly "${CURLY_COMP_SCRIPTS[@]}" -h)
C.alt C.rawWordOf "${#compFlags[@]}" "${compFlags[@]}" "$@"
fi
C.alt C.curly.flags flag 6 -h --help -v --version -i --interactive "$@"
......@@ -147,7 +153,7 @@ function C.curly.arg() {
C.alt C.curly.flags opt 2 -d --dump C.curly.library "$@"
C.alt C.curly.flags opt 2 -t --translate C.curly.translate "$@"
C.alt C.curly.flags opt 1 --banner C.fileIn -r . "$@"
C.alt C.curly.flags opt 5 --prelude --prelude+ --instance -e --execute C.any "$@"
C.alt C.curly.flags opt 7 -p -P --prelude --prelude+ --instance -e --execute C.any "$@"
C.alt C.curly.flags opt 1 --at C.curly.server "$@"
C.alt C.describing "Curly script, source or library" C.capture word SCRIPT C.fileIn CF.cyscript . C.curly.withScript C.describing "" "$@"
C.alt C.suffixed "@" C.wordOf 1 '' C.curly.server "$@"
......
......@@ -18,7 +18,7 @@
(1 font-lock-function-name-face)
(3 font-lock-keyword-face)
(4 font-lock-builtin-face))
'("^\\(\\(\\+\\S-*\\s-+\\)*\\)\\(mount\\)\\s-+\\([^=]*\\)=\\s-*\\(source\\|library\\|builtins\\|package\\)"
'("^\\(\\(\\+\\S-*\\s-+\\)*\\)\\(mount\\)\\s-+\\([^=]*\\)=\\s-*\\(\\(?:re\\)?source\\|library\\|builtins\\|package\\)"
(1 font-lock-function-name-face)
(3 font-lock-keyword-face)
(4 font-lock-variable-name-face)
......
......@@ -12,40 +12,52 @@ import Control.Concurrent.MVar (putMVar,takeMVar,newEmptyMVar,MVar)
import Control.Exception (AsyncException(..),Exception(..),bracket_)
import Curly.Core
import Curly.Core.Library
import Curly.Core.Parser
import Curly.Core.Peers
import Curly.Core.Security
import Curly.Core.VCS
import Curly.Core.VCS.Diff (patch)
import Curly.Core.Security
import Curly.Session
import Curly.System
import Curly.System.Base
import Curly.UI
import Curly.UI.Options hiding (nbsp,spc)
import Curly.Core.Parser
import Data.IORef
import GHC.Conc (threadDelay)
import GHC.IO.Encoding (utf8,setLocaleEncoding)
import IO.Filesystem
import IO.Time (currentTime)
import IO.Network.Socket
import IO.Time (currentTime)
import Language.Format
import Paths_curly
import System.Directory (doesFileExist)
import System.Environment (getArgs)
import System.Process (readProcess)
import System.IO (withFile,IOMode(..))
import Paths_curly
import System.Process (readProcess)
main :: IO ()
main = cli "curly" $ do
initCurly
args <- parseCurlyArgs <$> getArgs
let ?commandLineScripts = [s | Left s <- args]
withCurlyConfig args $ withCurlyPlex ?curlyConfig $ do
additional <- liftA2 (+)
(existingFiles [curlyUserDir</>"default.curly"])
(if any (has t'1) args then pure [] else existingFiles [".curly"])
let fullArgs = map Left additional + args
let ?commandLineScripts = [s | Left s <- fullArgs]
withCurlyConfig fullArgs $ withCurlyPlex ?curlyConfig $ do
let uninhibited = not ( any (has t'Help) (?curlyPlex^.targets)
|| all (has t'setting) (?curlyPlex^.targets) )
tgts = try [Help] (guard uninhibited >> ?curlyPlex^.targets)
runTargets tgts
existingFiles :: [String] -> IO [String]
existingFiles fs = do
exs <- traverse doesFileExist fs
return (fold (zipWith (\ex f -> fill f (guard ex)) exs fs))
data TargetType = ForkTgt (MVar ())
| IOTgt (IO ())
......
......@@ -14,7 +14,8 @@ import Curly.Session.Commands.Common
cleanCmd,metaCmd,reloadCmd,fixCmd :: Interactive Command
cleanDoc = "{section {title Clean Cache} Removes all cache files}"
cleanCmd = withDoc cleanDoc $ False <$ liftIO (sequence_ [clean c | (_,Source _ _ c) <- ?curlyPlex^.mounts])
cleanCmd = withDoc cleanDoc $ False <$ liftIO (do sequence_ [clean c | (_,Source _ _ c) <- ?curlyPlex^.mounts]
sequence_ [clean c | (_,Resource _ c) <- ?curlyPlex^.mounts])
where clean c = do
x <- getFile c
forl_ (descendant.fileAttrs.relPath) x $ \p -> case c+p of
......
......@@ -103,7 +103,7 @@ formatCmd = withDoc formatDoc . fill False $ do
(["strictness"],Pure $ document (snd $ exprStrictness $ v^.leafVal))
] zero
in p
withStyle $ withPatterns $ serveStrLn (docString ?terminal ?style (document (map (\v -> fromMaybe nodoc (evalDocWithPatterns ?patterns (params v) pat)) ctx)))
withStyle $ withPatterns $ serveStrLn (docString ?terminal ?style (document (map (\v -> fromMaybe (nodoc (format "Unmatched pattern %s" (show pat))) (evalDocWithPatterns ?patterns (params v) pat)) ctx)))
patternCmd = withDoc "{section {title Define Patterns} {p {em Usage:} pattern PATH = PATTERN} {p Defines a new query pattern accessible with \\{pattern PATH\\}}}" . fill False $ do
ph:pt <- many1' (nbhsp >> dirArg <*= guard . (/="="))
......
module Curly.Style(
-- * Writing documentation out
-- * Posix terminals for more entertaining documentation rendering
POSIXTerm,setupTerm,setupTermFromEnv) where
import Definitive
......
......@@ -22,6 +22,7 @@ import Curly.Core
import Curly.Core.Library
import Curly.Core.Parser hiding (nbsp,spc)
import Curly.Core.Security
import Curly.Core.Annotated
import Curly.UI.Options
import Data.IORef
import Data.List (sortBy)
......@@ -43,25 +44,68 @@ reloadMountain = liftIOLog $ do
getl l'2
liftIO $ traverse_ ($m) callbacks
makeFileModule :: (FileAttrs -> Bytes -> Maybe String -> (String,FileLibrary))
-> (String -> String)
-> File -> Module FileLibrary
makeFileModule getLib transformFileName x =
let inc (File a s (Just bs)) = Pure $ warp flLibrary rename lib
where (n',lib) = getLib a bs s
rename = warp exports f
where f (Pure (GlobalID _ l,v)) = Pure (GlobalID n' l,v)
f y = y
inc (Directory m) = Join (ModDir (m^.ascList & map snd . sortBy (comparing fst) . \l -> l <&> \(s,e) ->
let (n,s') = curlyFileName s in (n,(s',inc e))))
inc _ = zero
modDir (Directory m) = Directory (m&ascList %~ \l -> [(case f of
File _ _ _ -> transformFileName s
_ -> s,
modDir f)
| (s,f) <- l])
modDir (File a b t) = File (a&relPath %~ transformFileName) b t
in inc (modDir x)
sourceFile :: (?mountain :: Mountain) => [String] -> (String,String) -> File -> Module FileLibrary
sourceFile base dirs x =
sourceFile base dirs =
let ?mountain = fromMaybe zero (?mountain^?atMs base)
in let inc (File a s (Just _)) = Pure $ warp flLibrary rename lib
where n' = snd (curlyFileName (takeFileName (a^.relPath)))
lib = cacheCurly dirs a s
rename = warp exports f
where f (Pure (GlobalID _ l,v)) = Pure (GlobalID n' l,v)
f y = y
inc (Directory m) = Join (ModDir (m^.ascList & map snd . sortBy (comparing fst) . \l -> l <&> \(s,e) ->
let (n,s') = curlyFileName s in (n,(s',inc e))))
inc _ = zero
modDir (Directory m) = Directory (m&ascList %~ \l -> [(s',modDir f) | (s,f) <- l
, s' <- pure $ case f of
File _ _ _ -> fromMaybe s (noCurlySuf s)
_ -> s])
modDir (File a b t) = File (a&relPath %~ \x -> fromMaybe x (noCurlySuf x)) b t
in inc (modDir x)
in makeFileModule
(\a _ s -> (snd (curlyFileName (takeFileName (a^.relPath))),
cacheCurly dirs a s))
(\x -> fromMaybe x (noCurlySuf x))
resourceFile :: (String,String) -> File -> Module FileLibrary
resourceFile dirs = makeFileModule
(\a bs _ -> (takeFileName (a^.relPath)
,cacheResource dirs a bs))
id
cacheResource :: (String,String) -> FileAttrs -> Bytes -> FileLibrary
cacheResource (src,cache) a bs = by thunk $ do
isInvalid <- (>) (a^.lastMod) <$> modTime cacheName
if isInvalid
then do
let canPath = cacheFileName curlyCacheDir (show (lib^.flID)) "cyl"
createFileDirectory cacheName ; createFileDirectory canPath
writeBytes canPath (lib^.flBytes)
modifyPermissions canPath (set (each.executePerm) True)
trylog unit $ removeLink cacheName
createSymbolicLink canPath cacheName
return lib
else do
ser <- slurpBytes cacheName
return
$ maybe (error $ format "%s: Invalid library file format" cacheName) (\l -> rawLibrary False l ser Nothing)
$ matches Just datum ser
where bval = B_Bytes bs
sym = mkSymbol (pureIdent "value",Pure (Builtin (builtinType bval) bval))
lib = fileLibrary (zero
& set symbols (singleton "value" (undefLeaf "" & set leafVal sym & set leafType (builtinType bval)))
& setExports (Pure "value")) Nothing
cacheName = cache+a^.relPath+".cyl"
sourceName = src+a^.relPath
cacheCurly :: (?mountain :: Mountain) => (String,String) -> FileAttrs -> Maybe String -> FileLibrary
cacheCurly (src,cache) a ms = by thunk $ do
let filename d e = case a^.relPath of
......@@ -125,7 +169,8 @@ slurpBytes x = yb chunk <$> withFile x ReadMode (\h -> readHChunk h <*= \c -> c`
mountain :: (?curlyPlex :: CurlyPlex) => IO Mountain
mountain = mfix $ \c -> let ?mountain = c in do
let ren n = t'Pure.flLibrary.exports.t'Pure.l'1 %- pureIdent n
-- let ren n = t'Pure.flLibrary.exports.t'Pure.l'1 %- pureIdent n
let ren _ m = m
mnts <- for (?curlyPlex^.mounts) $ \(p,src) -> do
mod <- case src of
Library l -> return $ Pure (fromMaybe (error $ "Could not find library "+show l) (findLib l))
......@@ -135,6 +180,7 @@ mountain = mfix $ \c -> let ?mountain = c in do
$ matches Just datum ser
return $ Pure $ rawLibrary False lib ser Nothing
Source b s c -> getFile s <&> \f -> sourceFile b (s,c) f
Resource s c -> resourceFile (s,c) <$> getFile s
return (atMs p %- ren (last p) mod)
return $ compose mnts (Join zero)
......@@ -142,6 +188,7 @@ watchSources :: (?curlyPlex :: CurlyPlex) => IO ()
watchSources = do
sequence_ [watchFile s reloadMountain | (_,Source _ s _) <- ?curlyPlex^.mounts]
sequence_ [watchFile f reloadMountain | (_,LibraryFile f) <- ?curlyPlex^.mounts]
sequence_ [watchFile f reloadMountain | (_,Resource f _) <- ?curlyPlex^.mounts]
parseCurlyArgs :: [String] -> [String :+: [CurlyOpt]]
parseCurlyArgs args = fromMaybe [] $ matches Just (tokenize (map2 Right curlyOpts) naked) args
......
......@@ -38,6 +38,7 @@ t'Target k (Target t) = Target<$>k t
t'Target _ x = pure x
data InputSource = Source [String] String String
| Resource String String
| Library LibraryID
| LibraryFile String
deriving (Eq,Ord)
......@@ -45,6 +46,7 @@ instance Show InputSource where
show (Source p s c) = "source"+showSub+" "+s+" "+c
where showSub | empty p = ""
| otherwise = "["+intercalate " " p+"] "
show (Resource p c) = "resource "+p+" "+c
show (Library i) = "library "+show i
show (LibraryFile f) = "library @"+f
instance FormatArg InputSource where argClass _ = 'I'
......@@ -234,7 +236,7 @@ visible lim = many1' (satisfy (not . \c -> isSpc c || c=='\n' || c`elem`lim))
inputSource base = do
p <- sepBy' (visible "=") nbsp
between spc spc (several "=")
(p,) <$> (src <+? lib <+? search <+? blts)
(p,) <$> (src <+? rsc <+? lib <+? search <+? blts)
where src = do
like "source"
sub <- option' [] (between (single '[') (single ']')
......@@ -245,6 +247,11 @@ inputSource base = do
let defaultCache = fromMaybe (n+".cache") (noCurlySuf n <&> (+".cyl"))
m <- option' defaultCache (nbsp >> visible "")
return (Source sub (base</>n) (base</>m))
rsc = do
like "resource"
n <- nbsp >> visible ""
m <- option' (n+".cache") (nbsp >> visible "")
return (Resource (base</>n) (base</>m))
search = like "package" >> nbsp >> do
let tag x l = Join (DocTag x [] l)
tpl <- (docAtom <*= guard . has t'Join)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment