Skip to content

Commit

Permalink
elif support, maybe?
Browse files Browse the repository at this point in the history
  • Loading branch information
@gbaz
gbaz committed Jan 5, 2022
1 parent ec3763f commit 21ebfc1
Showing 1 changed file with 37 additions and 27 deletions.
64 changes: 37 additions & 27 deletions cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,39 +159,55 @@ projectSkeletonImports = view traverseCondTreeC
parseProjectSkeleton :: FilePath -> HttpTransport -> Verbosity -> FilePath -> BS.ByteString -> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton cacheDir httpTransport verbosity source bs = (>>= sanityWalkPCS False) . runInnerParsers <$> linesToNode (BS.lines bs)
where
-- converts lines to a full tree node, recursively looping "go" to pull out conditional and import structure, then packing the whole thing up
linesToNode :: [BS.ByteString] -> IO (CondTree BS.ByteString [ProjectConfigImport] [BS.ByteString])
linesToNode ls = packResult . mconcat <$> go ls

packResult :: ([CondBranch BS.ByteString [ProjectConfigImport] [BS.ByteString]], [ProjectConfigImport], [BS.ByteString]) -> CondTree BS.ByteString [ProjectConfigImport] [BS.ByteString]
packResult (branches, imps, ls) = CondNode ls imps branches
linesToNode xs = (\(branches, imps, ls) -> CondNode ls imps branches) . mconcat <$> go xs

-- given a list of lines, pulls out the conditional and import structure
go :: [BS.ByteString] -> IO [([CondBranch BS.ByteString [ProjectConfigImport] [BS.ByteString]], [ProjectConfigImport], [BS.ByteString])]

This comment has been minimized.

Sign in to view

Copy link
@phadej

phadej Jan 6, 2022

Collaborator

Why you are parsing a list of lines? And not e.g. using Distribution.Fields machinery?

This comment has been minimized.

Sign in to view

Copy link
@gbaz

gbaz Jan 6, 2022

Author Collaborator

Because we need to use the legacy cabal.project parser for each chunk of lines, and that doesn't use Distribution.Fields. If/when we rewrite the legacy parser to be something more modern, then moving to the fields machinery for the overall skeleton as well makes sense.

This comment has been minimized.

Sign in to view

Copy link
@phadej

phadej Jan 9, 2022

Collaborator

But even the old parser, i.e. in cabal-install recognizes sections, it just doesn't recognize if:

% git diff
diff --git a/cabal.project b/cabal.project
index 6f01ad2..9104e35 100644
--- a/cabal.project
+++ b/cabal.project
@@ -20,3 +20,6 @@ package tree-diff
 -- allow-newer: *:ghc
 -- allow-newer: *:ghc-prim
 -- allow-newer: *:template-haskell
+
+if impl(ghc >=8.0)
+  ghc-options: -Wall

% cabal build --dry   
Warning: /code/public-haskell/tree-diff/cabal.project: Unrecognized section
'if' on line 24
Resolving dependencies...

In particular, https://github.com/haskell/cabal/blob/master/cabal-install/src/Distribution/Client/Config.hs#L1112-1117 begins with readFIelds which makes a skeleton. Similarly parseLegacyProjectConfig

So should parseProjectSkeleton begin with parseFields. I see the newest branch has a note, but I'd say it should be a requirement. You just make your life harder but not doing it right from beginning. (Doing with Distribution.Fields would be even greater, you can convert from newer fields to older fields too, as refactoring everything is indeed quite a lot to do).

This comment has been minimized.

Sign in to view

Copy link
@gbaz

gbaz Jan 11, 2022

Author Collaborator

ok, rewrite with legacy readFields done -- it was a bit of work, but its certainly somewhat cleaner.
go (l:ls)
| Just condition <- Var <$> detectCond l =
let (clause, rest) = splitTillIndented ls
in case rest of
(r:rs) | (BS.pack "else") `BS.isPrefixOf` r -> -- TODO handle elif
let (elseClause, lastRest) = splitTillIndented rs
in do
c1 <- linesToNode clause
c2 <- linesToNode elseClause
(([condIfThenElse condition c1 c2], [], []) :) <$> go lastRest
_ -> do
c1 <- linesToNode clause
(([condIfThen condition c1], [], []) :) <$> go rest
| (BS.pack "if(") `BS.isPrefixOf` l =
let (clause, rest) = splitWhileIndented ls

-- unpacks the results of loop into nested if else clauses
constructNestedConds topCond topClause [] [] =
do c1 <- linesToNode topClause
pure $ condIfThen (Var topCond) c1
constructNestedConds topCond topClause ((elifCond, elifClause):elifs) elseClause =
do c1 <- linesToNode topClause
condIfThenElse (Var topCond) c1 . CondNode [] [] . (:[]) <$> constructNestedConds elifCond elifClause elifs elseClause
constructNestedConds topCond topClause [] elseClause =
do c1 <- linesToNode topClause
c2 <- linesToNode elseClause
pure $ condIfThenElse (Var topCond) c1 c2

-- parse out the full list of if/else clauses
loop acc rss =
case rss of
(r:rs)
| BS.pack "elif" `BS.isPrefixOf` r ->
let (elseClause, lastRest) = splitWhileIndented rs
in loop ((r, elseClause):acc) lastRest
| BS.pack "else" `BS.isPrefixOf` r ->
let (elseClause, lastRest) = splitWhileIndented rs
in constructNestedConds l clause (reverse acc) elseClause
>>= (\c -> ((([c],[],[]) :) <$> go lastRest))
_ -> constructNestedConds l clause (reverse acc) []
>>= (\c -> ((([c],[],[]) :) <$> go rss))
in loop [] rest

| Just imp <- parseImport l = do x <- go . BS.lines =<< fetchImportConfig imp
((([], [imp], []) : x) ++) <$> go ls

| otherwise = (([], [], [l]) :) <$> go ls
go [] = pure []

splitTillIndented = span ((BS.pack " ") `BS.isPrefixOf`)
go [] = pure []

detectCond :: BS.ByteString -> Maybe BS.ByteString
detectCond l | (BS.pack "if(") `BS.isPrefixOf` l = Just l
splitWhileIndented = span ((BS.pack " ") `BS.isPrefixOf`)

| otherwise = Nothing
parseImport l | (BS.pack "import ") `BS.isPrefixOf` l = Just . BS.unpack $ BS.drop (length "import ") l
| otherwise = Nothing

runInnerParsers :: CondTree BS.ByteString [ProjectConfigImport] [BS.ByteString] -> ParseResult ProjectConfigSkeleton
runInnerParsers = (runConditionParsers =<<) . traverse (fmap (addProvenance . convertLegacyProjectConfig) . parseLegacyProjectConfig source . BS.unlines)

Expand Down Expand Up @@ -232,12 +248,6 @@ parseProjectSkeleton cacheDir httpTransport verbosity source bs = (>>= sanityWal
BS.readFile fp
Nothing -> BS.readFile pci


{-
-- TODO elif
-- TODO handle merge semantics for constraints specially
-}

------------------------------------------------------------------
-- Representing the project config file in terms of legacy types
--
Expand Down

0 comments on commit 21ebfc1

Please sign in to comment.