-- | Attempts to change an entry in temporary maps into its final form, making
--   all prerequisite entries into their final form in the process.
tryResolveOneMapEntry :: [Either L2.L2DomainID L2.L2BaseUnitsID] ->
                         (M.Map L2.L2DomainID L2.L2DomainExpression, M.Map L2.L2BaseUnitsID L2.L2UnitExpression) ->
                         S.Set (Either L2.L2DomainID L2.L2BaseUnitsID) ->
                         Either L2.L2DomainID L2.L2BaseUnitsID ->
                         ModelTranslation ((M.Map L2.L2DomainID L2.L2DomainExpression,
                                            M.Map L2.L2BaseUnitsID L2.L2UnitExpression),
                                           S.Set (Either L2.L2DomainID L2.L2BaseUnitsID))
tryResolveOneMapEntry stack currentMaps@(dm,um) done toFix
  | toFix `S.member` done = return (currentMaps, done)
  | toFix `elem` stack = do
    let describeMapEntry (Left dt) = "domain type at " ++ (show $ L2.l2DomainExpressionSS (dm!dt))
        describeMapEntry (Right uex) = "units expression at " ++ (show $ L2.l2UnitExSS (um!uex))
    let paths = intercalate ", which is referenced by "
                  (map describeMapEntry
                  ((toFix:(takeWhile (/= toFix) stack)) ++ [toFix]))
    fail $ "Aliases form a cycle, which is invalid: " ++ paths
  | otherwise =
    let
      initialContents = either (Left . flip M.lookup dm) (Right . flip M.lookup um) toFix
      allDeps = [Left domId | L2.L2DomainReference { L2.l2DomainExpressionRef = domId } <-
                    universeBi initialContents, domId `M.member` dm] ++
                [Right buid | L2.L2UnitExRef { L2.l2UnitExRef = buid } <-
                    universeBi initialContents, buid `M.member` um]
    in do
     (finalMaps@(dm, um), done') <-
       foldM (\(currentMaps, done) dep -> tryResolveOneMapEntry (toFix:stack) currentMaps done dep)
             (currentMaps, done) allDeps
     let
       fixup :: Data a => a -> a
       fixup =
           transformBi (replaceTempDomainEx dm) . transformBi (replaceTempUnitEx um)
     return (either (\l -> (M.update (Just . fixup) l dm, um))
                    (\r -> (dm, M.update (Just . fixup) r um)) toFix,
             S.insert toFix done)

-- | Maps a namespace ID to a 'friendly name' that can be displayed to the user.
--   The context namespace is used so that when there are several options the
--   most appropriate choice can be shown.
tryResolveOneMapEntry :: [Either L2.L2DomainID L2.L2BaseUnitsID] ->
                         (M.Map L2.L2DomainID L2.L2DomainExpression, M.Map L2.L2BaseUnitsID L2.L2UnitExpression) ->
                         S.Set (Either L2.L2DomainID L2.L2BaseUnitsID) ->
                         Either L2.L2DomainID L2.L2BaseUnitsID ->
                         ModelTranslation ((M.Map L2.L2DomainID L2.L2DomainExpression,
                                            M.Map L2.L2BaseUnitsID L2.L2UnitExpression),
                                           S.Set (Either L2.L2DomainID L2.L2BaseUnitsID))
tryResolveOneMapEntry stack currentMaps@(dm,um) done toFix
  | toFix `S.member` done = return (currentMaps, done)
  | toFix `elem` stack = do
    let describeMapEntry (Left dt) = "domain type at " ++ (show $ L2.l2DomainExpressionSS (dm!dt))
        describeMapEntry (Right uex) = "units expression at " ++ (show $ L2.l2UnitExSS (um!uex))
    let paths = intercalate ", which is referenced by "
                  (map describeMapEntry
                  ((toFix:(takeWhile (/= toFix) stack)) ++ [toFix]))
    fail $ "Aliases form a cycle, which is invalid: " ++ paths
  | otherwise =
    let
      initialContents = either (Left . flip M.lookup dm) (Right . flip M.lookup um) toFix
      allDeps = [Left domId | L2.L2DomainReference { L2.l2DomainExpressionRef = domId } <-
                    universeBi initialContents, domId `M.member` dm] ++
                [Right buid | L2.L2UnitExRef { L2.l2UnitExRef = buid } <-
                    universeBi initialContents, buid `M.member` um]
    in do
     (finalMaps@(dm, um), done') <-
       foldM (\(currentMaps, done) dep -> tryResolveOneMapEntry (toFix:stack) currentMaps done dep)
             (currentMaps, done) allDeps
     let
       fixup :: Data a => a -> a
       fixup =
           transformBi (replaceTempDomainEx dm) . transformBi (replaceTempUnitEx um)
     return (either (\l -> (M.update (Just . fixup) l dm, um))
                    (\r -> (dm, M.update (Just . fixup) r um)) toFix,
             S.insert toFix done)

-- | Maps a namespace ID to a 'friendly name' that can be displayed to the user.
--   The context namespace is used so that when there are several options the
--   most appropriate choice can be shown.
tryResolveOneMapEntry stack currentMaps@(dm,um) done toFix
  | toFix `S.member` done = return (currentMaps, done)
  | toFix `elem` stack = do
    let describeMapEntry (Left dt) = "domain type at " ++ (show $ L2.l2DomainExpressionSS (dm!dt))
        describeMapEntry (Right uex) = "units expression at " ++ (show $ L2.l2UnitExSS (um!uex))
    let paths = intercalate ", which is referenced by "
                  (map describeMapEntry
                  ((toFix:(takeWhile (/= toFix) stack)) ++ [toFix]))
    fail $ "Aliases form a cycle, which is invalid: " ++ paths
  | otherwise =
    let
      initialContents = either (Left . flip M.lookup dm) (Right . flip M.lookup um) toFix
      allDeps = [Left domId | L2.L2DomainReference { L2.l2DomainExpressionRef = domId } <-
                    universeBi initialContents, domId `M.member` dm] ++
                [Right buid | L2.L2UnitExRef { L2.l2UnitExRef = buid } <-
                    universeBi initialContents, buid `M.member` um]
    in do
     (finalMaps@(dm, um), done') <-
       foldM (\(currentMaps, done) dep -> tryResolveOneMapEntry (toFix:stack) currentMaps done dep)
             (currentMaps, done) allDeps
     let
       fixup :: Data a => a -> a
       fixup =
           transformBi (replaceTempDomainEx dm) . transformBi (replaceTempUnitEx um)
     return (either (\l -> (M.update (Just . fixup) l dm, um))
                    (\r -> (dm, M.update (Just . fixup) r um)) toFix,
             S.insert toFix done)

-- | Maps a namespace ID to a 'friendly name' that can be displayed to the user.
--   The context namespace is used so that when there are several options the
--   most appropriate choice can be shown.