mirror of
https://github.com/carp-lang/Carp.git
synced 2024-11-05 04:44:12 +03:00
commit
6daaf584ae
@ -45,6 +45,7 @@ library
|
||||
StartingEnv,
|
||||
RenderDocs,
|
||||
StructUtils,
|
||||
Path,
|
||||
Validate
|
||||
|
||||
build-depends: base >= 4.7 && < 5
|
||||
@ -73,6 +74,7 @@ executable carp
|
||||
, CarpHask
|
||||
, containers
|
||||
, directory
|
||||
, filepath
|
||||
, haskeline
|
||||
, process
|
||||
default-language: Haskell2010
|
||||
|
19
app/Main.hs
19
app/Main.hs
@ -1,10 +1,7 @@
|
||||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
import qualified System.Environment as SystemEnvironment
|
||||
import System.IO (stdout)
|
||||
import System.Console.Haskeline (runInputT)
|
||||
import System.Directory (doesPathExist, getHomeDirectory)
|
||||
import GHC.IO.Encoding
|
||||
|
||||
import ColorText
|
||||
@ -15,6 +12,7 @@ import StartingEnv
|
||||
import Eval
|
||||
import Util
|
||||
import Lookup
|
||||
import Path
|
||||
|
||||
defaultProject :: Project
|
||||
defaultProject =
|
||||
@ -25,12 +23,10 @@ defaultProject =
|
||||
, projectFiles = []
|
||||
, projectAlreadyLoaded = []
|
||||
, projectEchoC = False
|
||||
, projectLibDir = ".carp/libs/"
|
||||
, projectCarpDir = "./"
|
||||
, projectOutDir = case platform of
|
||||
Windows -> ".\\out"
|
||||
_ -> "./out"
|
||||
, projectDocsDir = "./docs/"
|
||||
, projectLibDir = "libs"
|
||||
, projectCarpDir = "."
|
||||
, projectOutDir = "out"
|
||||
, projectDocsDir = "docs"
|
||||
, projectDocsLogo = ""
|
||||
, projectDocsPrelude = ""
|
||||
, projectDocsURL = ""
|
||||
@ -80,9 +76,8 @@ main = do setLocaleEncoding utf8
|
||||
""
|
||||
execMode)
|
||||
context <- loadFiles startingContext coreModulesToLoad
|
||||
home <- getHomeDirectory
|
||||
let carpProfile = home ++ "/.carp/profile.carp"
|
||||
hasProfile <- doesPathExist carpProfile
|
||||
carpProfile <- configPath "profile.carp"
|
||||
hasProfile <- doesFileExist carpProfile
|
||||
context' <- if hasProfile
|
||||
then loadFiles context [carpProfile]
|
||||
else do --putStrLn ("No '" ++ carpProfile ++ "' found.")
|
||||
|
@ -10,6 +10,7 @@ import Data.Char (toLower, isUpper)
|
||||
import Util
|
||||
import Types
|
||||
import Obj
|
||||
import Path
|
||||
|
||||
data Args = Args { sourcePath :: String
|
||||
, prefixToRemove :: String
|
||||
@ -23,7 +24,7 @@ main = do parsedArgs <- cmdArgs (Args { sourcePath = def &= argPos 0
|
||||
&= summary "Carp Header Parse 0.0.1")
|
||||
let path = sourcePath parsedArgs
|
||||
if path /= ""
|
||||
then do source <- readFile path
|
||||
then do source <- slurp path
|
||||
putStrLn (joinWith "\n" (map pretty (parseHeaderFile path source
|
||||
(prefixToRemove parsedArgs)
|
||||
(kebabCase parsedArgs))))
|
||||
|
@ -1,14 +1,11 @@
|
||||
module Commands where
|
||||
|
||||
import System.Directory
|
||||
import System.Info (os)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State.Lazy (StateT(..), runStateT, liftIO, modify, get, put)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.List (elemIndex)
|
||||
import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..))
|
||||
import System.FilePath (takeDirectory)
|
||||
import System.IO
|
||||
import System.Process (callCommand, spawnCommand, waitForProcess)
|
||||
import Control.Exception
|
||||
import qualified Data.Map as Map
|
||||
@ -25,6 +22,7 @@ import Util
|
||||
import Lookup
|
||||
import RenderDocs
|
||||
import TypeError
|
||||
import Path
|
||||
|
||||
type CommandCallback = [XObj] -> StateT Context IO (Either (FilePathPrintLength -> EvalError) XObj)
|
||||
|
||||
@ -183,7 +181,7 @@ commandCat :: CommandCallback
|
||||
commandCat args =
|
||||
do ctx <- get
|
||||
let outDir = projectOutDir (contextProj ctx)
|
||||
outMain = outDir ++ "/" ++ "main.c"
|
||||
outMain = outDir </> "main.c"
|
||||
liftIO $ do callCommand ("cat -n " ++ outMain)
|
||||
return dynamicNil
|
||||
|
||||
@ -193,7 +191,8 @@ commandRunExe args =
|
||||
do ctx <- get
|
||||
let proj = contextProj ctx
|
||||
outDir = projectOutDir proj
|
||||
outExe = "\"" ++ outDir ++ pathSeparator ++ projectTitle (contextProj ctx) ++ "\""
|
||||
quoted x = "\"" ++ x ++ "\""
|
||||
outExe = quoted $ outDir </> projectTitle (contextProj ctx)
|
||||
if projectCanExecute proj
|
||||
then liftIO $ do handle <- spawnCommand outExe
|
||||
exitCode <- waitForProcess handle
|
||||
@ -232,10 +231,10 @@ commandBuild shutUp args =
|
||||
incl = projectIncludesToC proj
|
||||
includeCorePath = " -I" ++ projectCarpDir proj ++ "/core/ "
|
||||
flags = includeCorePath ++ projectFlags proj
|
||||
outDir = projectOutDir proj ++ pathSeparator
|
||||
outMain = outDir ++ "main.c"
|
||||
outExe = outDir ++ projectTitle proj
|
||||
outLib = outDir ++ projectTitle proj
|
||||
outDir = projectOutDir proj
|
||||
outMain = outDir </> "main.c"
|
||||
outExe = outDir </> projectTitle proj
|
||||
outLib = outDir </> projectTitle proj
|
||||
generateOnly = projectGenerateOnly proj
|
||||
liftIO $ createDirectoryIfMissing False outDir
|
||||
liftIO $ writeFile outMain (incl ++ okSrc)
|
||||
@ -486,7 +485,7 @@ commandAddRelativeInclude [x] =
|
||||
XObj (Str file) i@(Just info) t ->
|
||||
let compiledFile = infoFile info
|
||||
in commandAddInclude RelativeInclude [
|
||||
XObj (Str $ (takeDirectory compiledFile) ++ "/" ++ file) i t
|
||||
XObj (Str $ takeDirectory compiledFile </> file) i t
|
||||
]
|
||||
_ ->
|
||||
return (Left (EvalError ("Argument to 'include' must be a string, but was `" ++ pretty x ++ "`") (info x)))
|
||||
@ -806,7 +805,7 @@ commandReadFile :: CommandCallback
|
||||
commandReadFile [filename] =
|
||||
case filename of
|
||||
XObj (Str fname) _ _ -> do
|
||||
exceptional <- liftIO $ ((try $ readFile fname) :: (IO (Either IOException String)))
|
||||
exceptional <- liftIO $ ((try $ slurp fname) :: (IO (Either IOException String)))
|
||||
case exceptional of
|
||||
Right contents ->
|
||||
return (Right (XObj (Str contents) (Just dummyInfo) (Just StringTy)))
|
||||
|
38
src/Eval.hs
38
src/Eval.hs
@ -5,10 +5,7 @@ import Data.List.Split (splitOn, splitWhen)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State.Lazy (StateT(..), runStateT, liftIO, modify, get, put)
|
||||
import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..))
|
||||
import qualified System.IO as SysIO
|
||||
import System.Directory (doesFileExist, canonicalizePath, createDirectoryIfMissing, getCurrentDirectory, getHomeDirectory, setCurrentDirectory)
|
||||
import System.FilePath (takeDirectory)
|
||||
import System.Process (readProcess, readProcessWithExitCode)
|
||||
import System.Process (readProcessWithExitCode)
|
||||
import Control.Concurrent (forkIO)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromJust, mapMaybe, isJust, Maybe(..))
|
||||
@ -33,6 +30,7 @@ import Lookup
|
||||
import Qualify
|
||||
import TypeError
|
||||
import Concretize
|
||||
import Path
|
||||
|
||||
-- | Dynamic (REPL) evaluation of XObj:s (s-expressions)
|
||||
eval :: Env -> XObj -> StateT Context IO (Either EvalError XObj)
|
||||
@ -1069,22 +1067,21 @@ specialCommandMetaGet path key =
|
||||
commandLoad :: CommandCallback
|
||||
commandLoad [xobj@(XObj (Str path) i _)] =
|
||||
do ctx <- get
|
||||
home <- liftIO getHomeDirectory
|
||||
let proj = contextProj ctx
|
||||
libDir <- liftIO $ cachePath $ projectLibDir proj
|
||||
let relativeTo = case i of
|
||||
Just ii ->
|
||||
case infoFile ii of
|
||||
"REPL" -> "."
|
||||
file -> takeDirectory file
|
||||
Nothing -> "."
|
||||
proj = contextProj ctx
|
||||
libDir = home ++ "/" ++ projectLibDir proj
|
||||
carpDir = projectCarpDir proj
|
||||
fullSearchPaths =
|
||||
path :
|
||||
(relativeTo ++ "/" ++ path) : -- the path from the file that contains the '(load)', or the current directory if not loading from a file (e.g. the repl)
|
||||
map (++ "/" ++ path) (projectCarpSearchPaths proj) ++ -- user defined search paths
|
||||
[carpDir ++ "/core/" ++ path] ++
|
||||
[libDir ++ "/" ++ path]
|
||||
(relativeTo </> path) : -- the path from the file that contains the '(load)', or the current directory if not loading from a file (e.g. the repl)
|
||||
map (</> path) (projectCarpSearchPaths proj) ++ -- user defined search paths
|
||||
[carpDir </> "core" </> path] ++
|
||||
[libDir </> path]
|
||||
firstM _ [] = return Nothing
|
||||
firstM p (x:xs) = do
|
||||
q <- p x
|
||||
@ -1108,10 +1105,7 @@ commandLoad [xobj@(XObj (Str path) i _)] =
|
||||
if canonicalPath `elem` alreadyLoaded
|
||||
then
|
||||
return ()
|
||||
else do contents <- liftIO $ do
|
||||
handle <- SysIO.openFile canonicalPath SysIO.ReadMode
|
||||
SysIO.hSetEncoding handle SysIO.utf8
|
||||
SysIO.hGetContents handle
|
||||
else do contents <- liftIO $ slurp canonicalPath
|
||||
let files = projectFiles proj
|
||||
files' = if canonicalPath `elem` files
|
||||
then files
|
||||
@ -1152,19 +1146,17 @@ commandLoad [xobj@(XObj (Str path) i _)] =
|
||||
let split = splitOn "/" (replaceC ':' "_COLON_" url)
|
||||
fst = head split
|
||||
in if fst `elem` ["https:", "http:"]
|
||||
then joinWith "/" (tail split)
|
||||
then joinWith "/" $ tail $ tail split
|
||||
else
|
||||
if '@' `elem` fst
|
||||
then joinWith "/" (joinWith "@" (tail (splitOn "@" fst)) : tail split)
|
||||
else url
|
||||
tryInstallWithCheckout path toCheckout = do
|
||||
ctx <- get
|
||||
home <- liftIO getHomeDirectory
|
||||
let proj = contextProj ctx
|
||||
let libDir = home ++ "/" ++ projectLibDir proj
|
||||
let fpath = libDir ++ "/" ++ fromURL path ++ "/" ++ toCheckout
|
||||
fpath <- liftIO $ cachePath $ projectLibDir proj </> fromURL path </> toCheckout
|
||||
cur <- liftIO getCurrentDirectory
|
||||
_ <- liftIO $ createDirectoryIfMissing True fpath
|
||||
_ <- liftIO $ createDirectoryIfMissing True $ fpath
|
||||
_ <- liftIO $ setCurrentDirectory fpath
|
||||
(_, txt, _) <- liftIO $ readProcessWithExitCode "git" ["rev-parse", "--abbrev-ref=loose", "HEAD"] ""
|
||||
if txt == "HEAD\n"
|
||||
@ -1192,8 +1184,8 @@ commandLoad [xobj@(XObj (Str path) i _)] =
|
||||
realName = if ".carp" `isSuffixOf` realName'
|
||||
then realName'
|
||||
else realName' ++ ".carp"
|
||||
fileToLoad = fpath ++ "/" ++ realName
|
||||
mainToLoad = fpath ++ "/main.carp"
|
||||
fileToLoad = fpath </> realName
|
||||
mainToLoad = fpath </> "main.carp"
|
||||
in do
|
||||
res <- commandLoad [XObj (Str fileToLoad) Nothing Nothing]
|
||||
case res of
|
||||
@ -1222,7 +1214,7 @@ commandReload args =
|
||||
then
|
||||
return context
|
||||
else do
|
||||
contents <- readFile filepath
|
||||
contents <- slurp filepath
|
||||
let proj' = proj { projectAlreadyLoaded = filepath : alreadyLoaded }
|
||||
executeString False (context { contextProj = proj' }) contents filepath
|
||||
newCtx <- liftIO (foldM f ctx paths)
|
||||
|
@ -1,6 +1,5 @@
|
||||
module Obj where
|
||||
|
||||
import System.FilePath (takeFileName)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.List (intercalate, foldl')
|
||||
@ -9,6 +8,7 @@ import Control.Monad.State
|
||||
import Data.Char
|
||||
import Types
|
||||
import Util
|
||||
import Path (takeFileName)
|
||||
import Debug.Trace
|
||||
|
||||
-- | Will the lookup look at other Carp code or at C code. This matters when calling functions, should they assume it's a lambda or a normal C function?
|
||||
|
48
src/Path.hs
Normal file
48
src/Path.hs
Normal file
@ -0,0 +1,48 @@
|
||||
module Path where
|
||||
import Debug.Trace
|
||||
import qualified System.Directory as D
|
||||
import qualified System.FilePath.Posix as FP
|
||||
import qualified System.IO as IO
|
||||
import Util
|
||||
|
||||
(</>) :: FilePath -> FilePath -> FilePath
|
||||
(</>) = (FP.</>)
|
||||
|
||||
cachePath :: FilePath -> IO FilePath
|
||||
cachePath = xdgPath D.XdgCache
|
||||
|
||||
canonicalizePath :: FilePath -> IO FilePath
|
||||
canonicalizePath = fmap toStandard . D.canonicalizePath . toNative
|
||||
|
||||
configPath :: FilePath -> IO FilePath
|
||||
configPath = xdgPath D.XdgConfig
|
||||
|
||||
createDirectoryIfMissing :: Bool -> FilePath -> IO ()
|
||||
createDirectoryIfMissing b = D.createDirectoryIfMissing b . toNative
|
||||
|
||||
doesFileExist :: FilePath -> IO Bool
|
||||
doesFileExist = D.doesFileExist . toNative
|
||||
|
||||
getCurrentDirectory :: IO FilePath
|
||||
getCurrentDirectory = toStandard <$> D.getCurrentDirectory
|
||||
|
||||
slurp :: FilePath -> IO String
|
||||
slurp = IO.readFile . toNative
|
||||
|
||||
setCurrentDirectory :: FilePath -> IO ()
|
||||
setCurrentDirectory = D.setCurrentDirectory . toNative
|
||||
|
||||
takeDirectory :: FilePath -> FilePath
|
||||
takeDirectory = FP.takeDirectory
|
||||
|
||||
takeFileName :: FilePath -> FilePath
|
||||
takeFileName = FP.takeFileName
|
||||
|
||||
toNative :: FilePath -> FilePath
|
||||
toNative = if platform == Windows then map (\x -> if x == '/' then '\\' else x) else id
|
||||
|
||||
toStandard :: FilePath -> FilePath
|
||||
toStandard = if platform == Windows then map (\x -> if x == '\\' then '/' else x) else id
|
||||
|
||||
xdgPath :: D.XdgDirectory -> FilePath -> IO FilePath
|
||||
xdgPath t = fmap toStandard . D.getXdgDirectory t . (</>) "carp" . toNative
|
@ -10,15 +10,14 @@ import Text.Blaze.Html.Renderer.Pretty (renderHtml)
|
||||
import Text.Blaze.Internal (stringValue)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text.Lazy as T
|
||||
import Data.Text.Lazy.Encoding as E
|
||||
import Data.Text as Text
|
||||
import System.Directory
|
||||
import qualified Data.Map as Map
|
||||
import Debug.Trace
|
||||
|
||||
import Obj
|
||||
import Types
|
||||
import Util
|
||||
import Path
|
||||
|
||||
saveDocsForEnvs :: Project -> [(SymPath, Binder)] -> IO ()
|
||||
saveDocsForEnvs ctx pathsAndEnvBinders =
|
||||
@ -27,7 +26,7 @@ saveDocsForEnvs ctx pathsAndEnvBinders =
|
||||
generateIndex = projectDocsGenerateIndex ctx
|
||||
allEnvNames = fmap (getModuleName . fst . getEnvAndMetaFromBinder . snd) pathsAndEnvBinders
|
||||
in do mapM_ (saveDocsForEnvBinder ctx allEnvNames) pathsAndEnvBinders
|
||||
when generateIndex (writeFile (dir ++ "/" ++ title ++ "_index.html")
|
||||
when generateIndex (writeFile (dir </> title ++ "_index.html")
|
||||
(projectIndexPage ctx allEnvNames))
|
||||
putStrLn ("Generated docs to '" ++ dir ++ "'")
|
||||
|
||||
@ -72,7 +71,7 @@ saveDocsForEnvBinder :: Project -> [String] -> (SymPath, Binder) -> IO ()
|
||||
saveDocsForEnvBinder ctx moduleNames (pathToEnv, envBinder) =
|
||||
do let SymPath _ moduleName = pathToEnv
|
||||
dir = projectDocsDir ctx
|
||||
fullPath = dir ++ "/" ++ moduleName ++ ".html"
|
||||
fullPath = dir </> moduleName ++ ".html"
|
||||
string = renderHtml (envBinderToHtml envBinder ctx (show pathToEnv) moduleNames)
|
||||
createDirectoryIfMissing False dir
|
||||
writeFile fullPath string
|
||||
|
@ -9,8 +9,6 @@ import System.Console.Haskeline ( getInputLine
|
||||
, completeWordWithPrev
|
||||
)
|
||||
import Data.List (isPrefixOf)
|
||||
import System.Info (os)
|
||||
import System.Directory (getHomeDirectory)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
import Types
|
||||
@ -18,6 +16,7 @@ import Obj
|
||||
import Util
|
||||
import ColorText
|
||||
import Eval
|
||||
import Path
|
||||
import Parsing (balance)
|
||||
|
||||
completeKeywordsAnd :: Monad m => [String ] -> String -> String -> m [Completion]
|
||||
@ -69,10 +68,10 @@ completeKeywordsAnd words _ word = return $ findKeywords word (words ++ keywords
|
||||
|
||||
readlineSettings :: Monad m => [String] -> IO (Settings m)
|
||||
readlineSettings words = do
|
||||
home <- getHomeDirectory
|
||||
historyFile <- configPath "history"
|
||||
return $ Settings {
|
||||
complete = completeWordWithPrev Nothing ['(', ')', '[', ']', ' ', '\t', '\n'] (completeKeywordsAnd words),
|
||||
historyFile = Just $ home ++ "/.carp/history",
|
||||
historyFile = Just historyFile,
|
||||
autoAddHistory = True
|
||||
}
|
||||
|
||||
|
@ -70,12 +70,6 @@ platform =
|
||||
"darwin" -> MacOS
|
||||
"mingw32" -> Windows
|
||||
|
||||
pathSeparator :: String
|
||||
pathSeparator =
|
||||
case platform of
|
||||
Windows -> "\\"
|
||||
_ -> "/"
|
||||
|
||||
unionOfSetsInList (x:xs) =
|
||||
foldl' Set.union x xs
|
||||
unionOfSetsInList [] =
|
||||
|
Loading…
Reference in New Issue
Block a user