-- MCM - Machine Configuration Manager; manages the contents of files and directories
-- Copyright (c) 2013-2017 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 Interpret (run, fullyLoadSectionFromHandle)
where

import Control.Monad (unless, when)
import Data.Either (partitionEithers)
import Data.Maybe (fromMaybe, isNothing)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as TextIO
import qualified Data.Traversable as Traversable
import Numeric(readOct)
import System.Posix.Types(FileMode)
import System.Directory (doesFileExist)
import System.FilePath (combine)
import System.IO (Handle)

import FileCorrector (PathType(..), DirType(..), Path, Permissions(..), emptyPermissions, OwnerP(..), GroupP(..))
import InterpretState
import Parser (mcmLoadAndParse, mcmParse)
import ParserTypes (Import(..), PackagePath, lookupDefine, Section(..), Define(..), Invocation(..), InvocationArgs(..), CondLocal(..), packagePath, Content(..), Group(..), Separator(..), Prepend(..), Append(..), section, imports, InvocationCmd(..), ExpandedInvocationCmd(..), lookupImport, DefName(..), UnexpandedDefName(..), Ident(..), OptArgs(..), Locals(..), Value(..), MCMFile(..), VarsExpand(..),dummyDefName)
import VarsParser (expandString)

{- Interpreting stages:
 -  0) Parse the initial file to get an initial State
 -     (Inc. expanding any package-level lets)
 -  1) Run through all Imports, importing until everything loaded
 -  2) Run Defines, building up basic Path + fragments
 -  3) Load templates+raw and complete fragments
 -  4) Output fragments (completing Path)
 -}

run :: State -> (PackagePath, DefName, Args) -> IO (([Error], [String], Path, [(PackagePath, Group)]), State)
run s0 (pp, defname, args) = do
    (is, s1) <- case fst $ runInterpret s0 (lookupSection pp) of
            Just _ -> return ([], s0)
            Nothing -> loadSection s0 pp
    s2 <- loadImports' s1 is
    let (_, s3) = runInterpret s2 (interpret0 (pp, defname, args))
    (templatesAndRaws, s4) <- loadFiles s3
    let (_, s5) = runInterpret s4 (generate templatesAndRaws)
    return (getResult s5, s5)

-- Interpret the given (Section, DefineName, Args)
interpret0 :: (PackagePath, DefName, Args) -> Interpret ()
interpret0 (pp, defname, args) = do
    sect <- lookupSection pp
    (PLSection sect' plets) <- case sect of
                Just z -> return z
                Nothing -> do
                    addError $ "Section \"" ++ show pp ++ "\" not found in imported files."
                    return $ PLSection (Section [] Map.empty Map.empty) (AllLocals Map.empty)
    case lookupDefine sect' defname of
                    Just d' -> interpret pp plets defname d' args
                    Nothing -> addError $ "Define \"" ++ show defname ++ "\" not found in Section " ++ show pp

-- Should now have everything, so complete paths and output
generate :: Map.Map FilePath T.Text -> Interpret ()
generate templatesAndRaws = do
    let expander = fullExpandOne templatesAndRaws
    expandAllPending expander

loadFiles :: State -> IO (Map.Map FilePath T.Text, State)
loadFiles s = do
    let toLoad = getLoadFiles s
        (SearchPath sp) = getSearchPath s
        loadOne :: FilePath -> IO (FilePath, Maybe T.Text)
        loadOne f = do
            c <- keepTrying (loadOne' f) sp
            return (f, c)
        loadOne' :: FilePath -> FilePath -> IO (Maybe T.Text)
        loadOne' f d = do
            let f' = combine d f
            e <- doesFileExist f'
            if e
                then do
                    r <- TextIO.readFile f'
                    return $ Just r
                else return Nothing
    loaded <- mapM loadOne toLoad
    let tryFromMaybe :: (FilePath, Maybe T.Text) -> Interpret (FilePath, T.Text)
        tryFromMaybe (name, Just c) = return (name, c)
        tryFromMaybe (name, Nothing) = do
            addError $ "File not found in search path: " ++ name
            return (name, T.empty)
        (loaded', s') = runInterpret s (mapM tryFromMaybe loaded)
    return (Map.fromList loaded', s')

loadSection :: State -> PackagePath -> IO ([Import], State)
loadSection s0 pp = do
    let (SearchPath sp) = getSearchPath s0
    fpsect <- keepTrying (loadSect pp) sp
    let (fp, fileOrError) = fromMaybe ("dummy", Right $ MCMFile pp (Section [] Map.empty Map.empty)) fpsect
    return $ runInterpret s0 $ case fileOrError of
        Left es -> do
            pushLocation pp dummyDefName
            mapM_ addError (("Error parsing " ++ fp ++ ":"):es)
            popLocation
            return []
        Right sect -> do
            addNewSection pp (fp, sect)
            return $ imports (section sect)

fullyLoadSectionFromHandle :: FilePath -> Handle -> PackagePath -> State -> IO State
fullyLoadSectionFromHandle handleName h pp s0 = do
    t <- TextIO.hGetContents h
    loadImports $ snd $ runInterpret s0 $ case mcmParse t of
        Right a -> addNewSection pp (handleName, a)
        Left es -> do
            pushLocation pp dummyDefName
            mapM_ addError (("Error parsing " ++ handleName ++ ":"):es)
            popLocation
            return ()

-- Add the given section
-- and an error if the requested pp is not among them
-- and return the one requested by pp
addNewSection :: PackagePath -> (FilePath, MCMFile) -> Interpret ()
addNewSection pp (fp, ss) = do
    addSectionOrError ss
    r <- lookupSection pp
    case r of
        Nothing -> do
            addError $ "Section " ++ show pp ++ " not found in " ++ fp
            let dummy = MCMFile pp (Section [] Map.empty Map.empty)
            addSectionOrError dummy
            return ()
        Just _ -> return ()

uppercaseConsts :: Map.Map Ident Expander
uppercaseConsts =
            Map.fromList [((Ident . T.pack) "COMMA", Expanded $ T.pack ",")
                         ,((Ident . T.pack) "NEWLINE", Expanded $ T.pack "\n")
                         ,((Ident . T.pack) "SPACE", Expanded $ T.pack " ")
                         ,((Ident . T.pack) "TAB", Expanded $ T.pack "\t")
                         ]

-- Add the given section, or an error that it's aleady defined
addSectionOrError :: MCMFile -> Interpret ()
addSectionOrError (MCMFile name sect@(Section _ plets _)) = do
    s0 <- lookupSection name
    case s0 of
        Nothing -> do
            pushLocation name dummyDefName
            plets' <- solve' name (AllLocals uppercaseConsts) plets []
            addSection (name, PLSection sect plets')
            popLocation
        Just _ -> addError $ "Section " ++ show name ++ " already defined."

-- Try the given action repeatedly until one succeeds or all fail
keepTrying :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
keepTrying _ [] = return Nothing
keepTrying f (x:xs) = do
    r <- f x
    case r of
        Just _ -> return r
        Nothing -> keepTrying f xs

loadSect :: PackagePath -> FilePath -> IO (Maybe (FilePath, Either [String] MCMFile))
loadSect pp fp = do
    let f = combine fp (packagePath pp)
    e <- doesFileExist f
    if e
        then do
            r <- mcmLoadAndParse f
            return $ Just (f, r)
        else return Nothing

-- Interpret the given Define using the given args
interpret :: PackagePath -> PackageLets -> DefName -> Define -> Args -> Interpret ()
interpret pp (AllLocals plets) dName d args = do
    args' <- checkForMissingArgs dName (defArgs d) args
    let expectedargs = Set.fromList(defArgs d ++ Map.keys (fromOptArgs . defOptargs $ d))
        givenargs = Map.keysSet . fromArgs $ args'
    checkForExtraArgs expectedargs givenargs
    combined <- unionLocals (fromArgs args') plets
    pushLocation pp dName
    al <- solve pp d (Args combined)
    mapM_ (invoke pp al) (defInvokes d)
    popLocation

invoke :: PackagePath -> AllLocals -> Invocation -> Interpret ()
invoke pp al (Invocation icmd iargs) = do
    as <- expand pp al iargs
    let as' = Args as
    icmd' <- expandInvocationCmd pp al icmd
    alreadySeen <- logInvokeOf (icmd', pp, as')
    unless alreadySeen $ do
        let (doit, expectedArgSet) = invokationTable icmd' pp as'
        case expectedArgSet of
            Just expecArgSet -> checkForExtraArgs expecArgSet (Map.keysSet . fromInvocationArgs $ iargs)
            Nothing -> return ()
        doit

toIdentSet :: [String] -> Set.Set Ident
toIdentSet = Set.fromList . map (Ident . T.pack)

invokationTable :: ExpandedInvocationCmd -> PackagePath -> Args -> (Interpret (), Maybe (Set.Set Ident))
invokationTable ExInvDir pp as =
    (if allExpanded as then invokeDir as else invokeLater PendingPath pp as
    ,Just $ toIdentSet ["path", "owner", "group", "mode", "manage"]
    )
invokationTable ExInvFile pp as =
    (if allExpanded as then invokeFile as else invokeLater PendingFile pp as
    ,Just $ toIdentSet ["path", "owner", "group", "mode", "content"]
    )
invokationTable ExInvSymlink pp as =
    (if allExpanded as then invokeSymlink as else invokeLater PendingSymlink pp as
    ,Just $ toIdentSet ["path", "owner", "group", "mode", "link"]
    )
invokationTable ExInvAbsent pp as =
    (if allExpanded as then invokeAbsent as else invokeLater PendingAbsent pp as
    ,Just $ toIdentSet ["path"]
    )
invokationTable ExInvFragment pp as =
    (if allExpanded as then invokeFragment pp as else invokeLater PendingFragment pp as
    ,Just $ toIdentSet ["group", "name", "content"]
    )
-- NB. MUST return an "invoke now" - cannot put off for later (but don't need to)
invokationTable (ExInvLocal d) pp as =
    (interpret0 (pp, d, as), Nothing)
invokationTable (ExInvImport i d) pp as = (interpretImport, Nothing)
    where
        interpretImport = do
            thisSection <- lookupSection pp
            let thisSection' = fromMaybe (error $ "Internal error: could not lookup own section: " ++ show pp) thisSection
                impPP = lookupImport (imports.pl2section $ thisSection') i
            case impPP of
                Nothing -> addError $ "Import " ++ show i ++ " not found."
                Just impPP' -> interpret0 (impPP', d, as)

readFileMode :: String -> Interpret (Maybe FileMode)
readFileMode s = case readOct s of
                    [(x, "")] -> return $ Just x
                    _ -> do
                        addError $ "Failed to parse mode: " ++ s
                        return Nothing

parsePermissions :: Args -> Interpret Permissions
parsePermissions as = do
    let l = lookupExpanded as . Ident . T.pack
        o = l "owner"
        g = l "group"
        m = l "mode"
    m' <- case m of
            Nothing -> return Nothing
            Just s -> readFileMode $ T.unpack s
    o' <- case o of
            Nothing -> return Nothing
            Just s -> do
                s' <- parseOwner s
                return $ Just $ OwnerP (s, s')
    g' <- case g of
            Nothing -> return Nothing
            Just s -> do
                s' <- parseGroup s
                return $ Just $ GroupP (s, s')
    let perm = Perm m' o' g'
    return perm

-- To be called only once all args are Expanded
invokeDir :: Args -> Interpret ()
invokeDir as = do
    let l = lookupExpanded as . Ident . T.pack
        p = l "path"
        --t = Map.findWithDefault (Expanded $ T.pack "full") (T.pack "manage") as
        t = l "manage"
    perm <- parsePermissions as
    t' <- case t of
        Just e | e == T.pack "full" -> return Full
        Just e | e == T.pack "partial" -> return Partial
        Nothing -> return Full
        _ -> do
            addError $ "Invalid Directory manage type: " ++ show t
            return Partial
    case p of
        Just p' -> iAddPath (T.unpack p') (Dir t') perm
        Nothing -> addError "No path specified for directory"

-- To be called only once all args are Expanded
invokeSymlink :: Args -> Interpret ()
invokeSymlink as = do
    let l = lookupExpanded as . Ident . T.pack
        p = l "path"
        i = l "link"
    perm@(Perm m o g) <- parsePermissions as
    perm' <- if isNothing m
                then return perm
                else do
                    addError $ "It is not possible to set the mode of a symbolic link."
                        ++ "  Please explicitly set the mode of the destination instead."
                    return (Perm Nothing o g)
    i' <- case i of
        Nothing -> do
            addError "No link specified for symlink"
            return T.empty
        Just c -> return c
    case p of
        Just p' -> iAddPath (T.unpack p') (Symlink $ T.unpack i') perm'
        Nothing -> addError "No path specified for symlink"

invokeFile :: Args -> Interpret ()
invokeFile as = do
    let l = lookupExpanded as . Ident . T.pack
        p = l "path"
        t = l "content"
    perm <- parsePermissions as
    t' <- case t of
        Nothing -> do
            addError "No content specified for file"
            return T.empty
        Just c -> return c
    case p of
        Just p' -> iAddPath (T.unpack p') (File t') perm
        Nothing -> addError "No path specified for file"

invokeAbsent :: Args -> Interpret ()
invokeAbsent as = do
    let l = lookupExpanded as . Ident . T.pack
        p = l "path"
    case p of
        Just p' -> iAddPath (T.unpack p') Absent emptyPermissions
        Nothing -> addError "What is it that should be absent?"

invokeFragment :: PackagePath -> Args -> Interpret ()
invokeFragment pp as = do
    let l = lookupExpanded as . Ident . T.pack
        g = l "group"
        c = l "content"
        n = l "name"
    g' <- case g of
        Just s -> return s
        Nothing -> do
            addError "No group specified for Fragment"
            return $ T.pack "defaultGroup"
    c' <- case c of
        Just s -> return s
        Nothing -> do
            addError "No content specified for Fragment"
            return $ T.pack "defaultContent"
    addFragment pp (Group g') (fromMaybe c' n) c'

checkForExtraArgs :: Set.Set Ident -> Set.Set Ident -> Interpret ()
checkForExtraArgs expected actual =
    let difference = actual `Set.difference` expected
    in
        unless (Set.null difference) $
            addError $ "Unexpected argument(s): " ++ show (Set.toList difference)

checkForMissingArgs :: DefName -> [Ident] -> Args -> Interpret Args
checkForMissingArgs dName required args@(Args as) =
    let missing = Set.fromList required `Set.difference` Map.keysSet as
        dummy = Expanded $ T.pack "missingArg"
    in
        if Set.null missing then return args
        else do
            addError $ "Missing argument(s) in call of " ++ show dName
                       ++ "(): " ++ show (Set.toList missing)
            return $ Args $ as `Map.union` Map.fromList (map (\m -> (m, dummy)) required)


-- Suppose that State has been initialised
-- with the very first loaded file (stdin and/or first file loaded).
-- Load all Sections referenced in the Imports
loadImports :: State -> IO State
loadImports s0 = do
    let (imps, s1) = runInterpret s0 allImports
    loadImports' s1 imps

loadImports' :: State -> [Import] -> IO State
loadImports' s0 [] = return s0
loadImports' s0 (Import pp _:is) = do
    let (sect, s1) = runInterpret s0 (lookupSection pp)
    (newis, s2) <- case sect of
                Just _ -> return ([], s1)   -- No new imports (already loaded)
                Nothing -> loadSection s1 pp
    loadImports' s2 (is++newis)

unionLocals :: Map.Map Ident a -> Map.Map Ident a -> Interpret (Map.Map Ident a)
unionLocals a b =
    let u = a `Map.union` b
        i = a `Map.intersection` b
    in do
        unless (Map.null i) $ mapM_ (\k -> addError $ "local \"" ++ show k ++ "\" is defined multiple times") (Map.keys i)
        return u

insertLocal :: Ident -> a -> Map.Map Ident a -> Interpret (Map.Map Ident a)
insertLocal k v m = do
    when (k `Map.member` m) $ addError $ "local \"" ++ show k ++ "\" is defined multiple times"
    return $ Map.insert k v m

-- NB. Given args must take precedence over optargs
solve :: PackagePath -> Define -> Args -> Interpret AllLocals
solve pp d (Args a) =
    let (OptArgs a1) = defOptargs d
        (Locals a2) = defLocals d
        a1' = Map.filterWithKey (\k _ -> Map.notMember k a) a1
        alreadySolved = AllLocals a
    in do
        alreadySolved' <- solve' pp alreadySolved a1' []
        solve' pp alreadySolved' a2 (defCondlocals d)

--solve': AllLocals = solved already, Map = tosolve, [CondLocal] = conditionals
solve' :: PackagePath -> AllLocals -> Map.Map Ident [Content] -> [CondLocal] -> Interpret AllLocals
solve' pp (AllLocals al) c [] = do
    expanded <- solveExpand pp al (Map.toList c) []
    return $ AllLocals expanded
solve' pp al c (CondLocal cond alts:xs) = do
    solution <- evaluateCond pp al c cond
    let solveFor (Locals x) = do
            combined <- unionLocals c x
            solve' pp al combined xs
        defaultSolve = if Map.null alts
                        then return al
                        else solveFor $ snd $ Map.elemAt 0 alts
    case solution of
        Nothing -> defaultSolve
        Just s -> case Map.lookup (Value s) alts of
            Just a -> solveFor a
            Nothing -> do
                addError $ "Error evaluating " ++ show cond ++ ": expected one of " ++ (show . Map.keys) alts ++ " but got " ++ show solution ++ "."
                defaultSolve

-- Step 3: Expand any remaining @var-s
-- Need to trap recursion (as it can't terminate)
solveExpand :: PackagePath -> Map.Map Ident Expander -> [(Ident, [Content])] -> [(Ident, [Content])] -> Interpret (Map.Map Ident Expander)
solveExpand _ solved [] [] = return solved
solveExpand pp s [] unsolved = do
    let process e = case e of
            Right _ -> error "Unexpected state within solveExpand"
            Left e' -> addError e'
    errors <- mapM (expandOne pp (AllLocals s) . snd) unsolved
    mapM_ process errors
    return s
solveExpand pp s ((a,b):xs) u = do
    expanded <- expandOne pp (AllLocals s) b
    case expanded of
        Right b' -> do
            combined <- insertLocal a b' s
            solveExpand pp combined (u++xs) []
        Left _ -> solveExpand pp s xs ((a,b):u) -- Todo: it might be worth saving the error (_) on the unsolved list

-- Solve the given conditional (case variable)
evaluateCond :: PackagePath -> AllLocals -> Map.Map Ident [Content] -> Ident -> Interpret (Maybe T.Text)
evaluateCond pp (AllLocals al) unsolvedlocals s =
    case Map.lookup s al of
        Just (Expanded e) -> return $ Just e
        _ -> case Map.lookup s unsolvedlocals of
                Just b -> do
                    b' <- expandOne pp (AllLocals al) b
                    case b' of
                        Left e -> do
                            addError $ "Failed to expand " ++ show b ++ " for the case expression \"" ++ show s ++ "\": " ++ e
                            return Nothing
                        Right (Expanded b'') -> return $ Just b''
                        Right _ -> do
                            addError $ "Failed to expand " ++ show b ++ " for the case expression \"" ++ show s ++ "\" as case expansions must be simple"
                            return Nothing
                Nothing -> do
                    addError $ "Failed to find definition for case variable \"" ++ show s ++ "\""
                    return Nothing

{- Simultaneous equations :(
 - I need way of saying "solve [Content] to a string now if you can",
 - and otherwise store the equations for solving later.
 - Content -> Resolution:
 -  CWord -> now (solve first with al)
 -  CLine -> now (solve first with al)
 -  CFile -> later (requires IO; solve now and later with al)
 -  CFragments -> later (need to generate all fragments first; solve now and later with al; enumerate dependent fragments for dependency-calculating)
 -  CRawFile -> later (requires IO; can solve with al now though)
 - Perhaps it would help to have loaded all templates & raw files in advance?
 - I still need to do fragments later though (once generated).
 -}

expandOne :: PackagePath -> AllLocals -> [Content] -> Interpret (Either String Expander)
expandOne _ _ [] = return $ Right $ Expanded $ T.pack ""
expandOne _ _ [CEmpty] = return $ Right $ Expanded $ T.pack ""
expandOne _ _ [CNewline] = return $ Right $ Expanded $ T.pack "\n"
expandOne _ _ [CRawString s] = return $ Right $ Expanded s
expandOne _ al [CString w] = return $ expandStringFromAl al w
expandOne _ al [CExplicitString w] = return $ expandStringFromAl al w
expandOne _ al [CRawFile f] =
    case expandStringFromAl al f of
        Right (Expanded s) -> do
            let s' = T.unpack s
            addToLoad s'
            return $ Right $ ERawFile s'
        Right _ -> return $ Left "Only simple expansions supported for filenames"
        Left e  -> return $ Left e
expandOne _ al [CFile f] =
    case expandStringFromAl al f of
        Right (Expanded s) -> do
            let s' = T.unpack s
            addToLoad s'
            return $ Right $ EFile s' al
        Right _ -> return $ Left "Only simple expansions supported for filenames"
        Left e  -> return $ Left e
expandOne pp al [CFragments (Group g) (Prepend prepend) (Append append) (Separator sep)] = do
    g' <- case expandStringFromAl al g of
        Right (Expanded s) ->
            return s
        Right _ -> do
            addError "Only simple expansions supported for group identifiers"
            return $ T.pack "complicatedGroupExpansion"
        Left e  -> do
            addError e
            return $ T.pack "erroneousGroupExpansion"
    prepend' <- case expandStringFromAl al prepend of
        Right (Expanded s) ->
            return s
        Right _ -> do
            addError "Only simple expansions supported for fragment prepend strings"
            return $ T.pack "complicatedPrependExpansion"
        Left e  -> do
            addError e
            return $ T.pack "erroneousPrependExpansion"
    append' <- case expandStringFromAl al append of
        Right (Expanded s) ->
            return s
        Right _ -> do
            addError "Only simple expansions supported for fragment append strings"
            return $ T.pack "complicatedAppendExpansion"
        Left e  -> do
            addError e
            return $ T.pack "erroneousAppendExpansion"
    sep' <- case expandStringFromAl al sep of
        Right (Expanded s) ->
            return s
        Right _ -> do
            addError "Only simple expansions supported for fragment separators"
            return $ T.pack "complicatedSeparatorExpansion"
        Left e  -> do
            addError e
            return $ T.pack "erroneousSeparatorExpansion"
    return $ Right $ EFragments pp (Group g') (Prepend prepend') (Append append') (Separator sep')
expandOne pp al xs = do
    singles <- mapM (expandOne pp al . (:[])) xs
    case partitionEithers singles of
        ([], successes) -> return $ Right $ collapseExpander successes
        (e:_, _) -> return $ Left e

expand :: PackagePath -> AllLocals -> InvocationArgs -> Interpret (Map.Map Ident Expander)
expand pp al (InvocationArgs iargs) = Traversable.mapM expand' iargs
    where
        expand' :: [Content] -> Interpret Expander
        expand' iarg = do
            x <- expandOne pp al iarg
            case x of
                Left e -> do
                    addError e
                    return $ Expanded $ T.pack "erroneousExpansion"
                Right y -> return y

expandInvocationCmd' :: PackagePath -> AllLocals -> UnexpandedDefName -> Interpret DefName
expandInvocationCmd' pp al ud@(UnexpandedDefName u) = do
            x <- expandOne pp al [CString u]
            case x of
                Left e -> do
                    addError e
                    return $ DefName $ T.pack "erroneousExpansion"
                Right (Expanded y) -> return $ DefName y
                Right _ -> do
                    addError $ "Failed to fully expand: " ++ show ud
                    return $ DefName $ T.pack "erroneousExpansion"

expandInvocationCmd :: PackagePath -> AllLocals -> InvocationCmd -> Interpret ExpandedInvocationCmd
expandInvocationCmd _ _ InvFile = return ExInvFile
expandInvocationCmd _ _ InvDir = return ExInvDir
expandInvocationCmd _ _ InvAbsent = return ExInvAbsent
expandInvocationCmd _ _ InvFragment = return ExInvFragment
expandInvocationCmd _ _ InvSymlink = return ExInvSymlink
expandInvocationCmd pp al (InvLocal u) = do
    d <- expandInvocationCmd' pp al u
    return $ ExInvLocal d
expandInvocationCmd pp al (InvImport i u) = do
    d <- expandInvocationCmd' pp al u
    return $ ExInvImport i d

allExpanded :: Args -> Bool
allExpanded (Args m) = allExpanded' (Map.elems m)
    where
        allExpanded' :: [Expander] -> Bool
        allExpanded' [] = True
        allExpanded' (Expanded _ :xs) = allExpanded' xs
        allExpanded' _ = False

lookupExpanded :: Args -> Ident -> Maybe T.Text
lookupExpanded (Args as) s = fromExpanded $ Map.lookup s as
    where
        fromExpanded :: Maybe Expander -> Maybe T.Text
        fromExpanded Nothing = Nothing
        fromExpanded (Just (Expanded e)) = Just e
        fromExpanded e = error $ "lookupExpanded should only ever be called when all args are fully expanded, but got: " ++ show e

fullExpandOne :: Map.Map FilePath T.Text -> Expander -> Interpret Expander
fullExpandOne _ e@(Expanded _) = return e
fullExpandOne templatesAndRaws (EFile fp al) = do
    let l = Map.lookup fp templatesAndRaws
    case l of
        Just s -> case expandStringFromAl al s of
                    Left err -> do
                        addError $ "Error parsing template '" ++ fp ++ "': " ++ err
                        return $ Expanded $ T.pack "erroneousTemplate"
                    Right s' -> return s'
        Nothing -> do
            addError $ "Internal program error: template \""++fp++"\" not found."
            return $ Expanded $ T.pack "erroneousTemplate2"
-- EFragments pp, g and s are fully expanded; assume that all fragments have been generated
fullExpandOne _ (EFragments pp g (Prepend p) (Append a) (Separator s)) = do
    frags <- takeFragments pp g
    return $ Expanded $ T.intercalate s $ map (\f -> p `T.append` f `T.append` a) frags
fullExpandOne templatesAndRaws (ERawFile fp) = do
    let l = Map.lookup fp templatesAndRaws
    case l of
        Just s -> return $ Expanded s
        Nothing -> do
            addError $ "Internal program error: raw \""++fp++"\" not found."
            return $ Expanded $ T.pack "erroneousRaw2"
fullExpandOne templatesAndRaws (EMulti es) = do
    es' <- mapM (fullExpandOne templatesAndRaws) es
    let r = foldr1 (\(Expanded a) (Expanded b) -> Expanded (a `T.append` b)) es'
    return r

-- Assume that everything expands perfectly
-- Run invocations in the order supplied (completing Path)
expandAllPending :: (Expander -> Interpret Expander) -> Interpret ()
expandAllPending expander = do
    invocations <- takeAllLaters
    mapM_ expandAndInvoke invocations
    where
        expandAndInvoke (cmd, pp, as) = do
            (cmd', pp', as') <- expandit (cmd, pp, as)
            expandAllPending' cmd' pp' as'
        expandit :: (PendingCmd, PackagePath, Args)
                    -> Interpret (PendingCmd, PackagePath, Args)
        expandit (cmd, pp, Args as) = do
            as' <- Traversable.mapM expander as
            return (cmd, pp, Args as')
        expandAllPending' :: PendingCmd -> PackagePath -> Args -> Interpret ()
        expandAllPending' PendingFile _ = invokeFile
        expandAllPending' PendingPath _ = invokeDir
        expandAllPending' PendingSymlink _ = invokeSymlink
        expandAllPending' PendingAbsent _ = invokeAbsent
        expandAllPending' PendingFragment pp = invokeFragment pp

expandStringFromAl :: AllLocals -> T.Text -> Either String Expander
expandStringFromAl (AllLocals al) =
    expandString $ VarsExpand (\i _ -> i `Map.lookup` al) Expanded collapseExpander (\a _ -> Expanded a)