-- MCM - Machine Configuration Manager; manages the contents of files and directories -- Copyright (c) 2013-2018 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . module VarsParser (expandString) where import Control.Monad(unless) import Data.Char (isAlphaNum) import qualified Data.Text.Lazy as T import Text.ParserCombinators.Poly.Text import ParserTypes (Ident(..), VarsExpand(..)) -- Perform substitution on strings like "Fifty @(pound)s of @rice" expandString :: VarsExpand a -> T.Text -> Either String a expandString ve t = case runParser (pSplitter ve) t of (Left s, _) -> Left s (Right e, v) -> if T.null v then Right e else Left $ "Failed to parse end: " ++ T.unpack v isVar :: Char -> Bool isVar c = isAlphaNum c || c `elem` "_" doReplace :: VarsExpand a -> T.Text -> T.Text -> Parser a doReplace ve t r = case vexpand ve (Ident t) r of Just s -> return s Nothing -> failBad $ "Failed to lookup @" ++ T.unpack t char :: Char -> Parser () char c = do n <- next unless (c == n) $ fail "Failed to match char" pSplitter :: VarsExpand a -> Parser a pSplitter ve = vcollapse ve <$> (many . oneOf) [vnoexpand ve <$> many1Satisfy (/= '@') ,do char '@' oneOf [do v <- many1Satisfy isVar commit $ doReplace ve v $ T.cons '@' v ,do char '(' v <- many1Satisfy isVar commit $ char ')' `adjustErr ` ("expected closing bracket\n"++) doReplace ve v $ T.concat [T.pack "@(", v, T.pack ")"] ,do char '@' commit $ return $ vescapeexpand ve (T.pack "@") (T.pack "@@") ] ]