mcm-0.6.4.10: VarsParser.hs

-- MCM - Machine Configuration Manager; manages the contents of files and directories
-- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>
--
-- 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 <http://www.gnu.org/licenses/>.

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 "@@")
            ]
    ]