80 lines
2.6 KiB
Haskell
80 lines
2.6 KiB
Haskell
module GHCup.Bash where
|
|
|
|
import Data.ByteString
|
|
import Language.Bash.Parse.Word
|
|
import Language.Bash.Word
|
|
import Language.Bash.Syntax
|
|
import Text.Parsec
|
|
import HPath
|
|
import Data.ByteString.UTF8 ( toString )
|
|
import Streamly
|
|
import GHCup.File
|
|
import GHCup.Prelude ( internalError )
|
|
import qualified Streamly.Prelude as S
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
|
|
|
|
-- | Parse a single assignment of the given line.
|
|
parseAssignment :: SourceName -- ^ file/location of the parser
|
|
-> ByteString -- ^ the line as a bytestring
|
|
-> Either ParseError Assign
|
|
parseAssignment = runParser assign ()
|
|
|
|
|
|
-- | Parse assignments in a stream.
|
|
parseAssignments :: Monad m
|
|
=> SourceName -- ^ file/location of the parser
|
|
-> SerialT m (ByteString)
|
|
-> SerialT m (Either ParseError Assign)
|
|
parseAssignments sn = fmap (parseAssignment sn)
|
|
|
|
|
|
-- | Find an assignment matching the predicate in the given file.
|
|
findAssignment :: Path b
|
|
-> (Assign -> Bool) -- ^ predicate
|
|
-> IO (Maybe Assign)
|
|
findAssignment p predicate = do
|
|
let fn' = toString . toFilePath $ p
|
|
stream <- fmap (parseAssignments fn') $ readFileLines p
|
|
res <-
|
|
S.find -- empties the stream on first match, but doesn't terminate it
|
|
(\case
|
|
Right ass -> predicate ass
|
|
Left _ -> False
|
|
)
|
|
stream
|
|
>>= \case
|
|
Just (Right x) -> pure (Just x)
|
|
Just (Left _) ->
|
|
internalError "unexpected Left in findAssignment"
|
|
Nothing -> pure Nothing
|
|
-- Closes the file handle. Because if there was a match, then
|
|
-- the stream is not terminated.
|
|
when (isJust res) $ S.drain stream
|
|
pure res
|
|
|
|
|
|
-- | Check that the assignment is of the form Foo= ignoring the
|
|
-- right hand-side.
|
|
equalsAssignmentWith :: String -> Assign -> Bool
|
|
equalsAssignmentWith n ass = case ass of
|
|
(Assign (Parameter name' Nothing) Equals _) -> n == name'
|
|
_ -> False
|
|
|
|
|
|
-- | This pretty-prints the right hand of an Equals assignment, removing
|
|
-- quotations. No evaluation is performed.
|
|
getRValue :: Assign -> Maybe String
|
|
getRValue ass = case ass of
|
|
(Assign (Parameter _ _) Equals (RValue w)) -> Just $ unquote w
|
|
_ -> Nothing
|
|
|
|
|
|
-- | Given a bash assignment such as Foo="Bar" in the given file,
|
|
-- will return "Bar" (without quotations).
|
|
getAssignmentValueFor :: Path b -> String -> IO (Maybe String)
|
|
getAssignmentValueFor p n = do
|
|
mass <- findAssignment p (equalsAssignmentWith n)
|
|
pure (mass >>= getRValue)
|