-- Copyright (c) 2009, ERICSSON AB
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | General utility functions

module Feldspar.Utils where



import Control.Monad.State
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map



-- | Checks if all elements in the list are equal.
allEqual :: Eq a => [a] -> Bool
allEqual []     = True
allEqual (a:as) = all (==a) as

-- | @showSeq open strs close@:
--
-- Shows the strings @strs@ separated by commas and enclosed within the @open@
-- and @close@ strings.
showSeq :: String -> [String] -> String -> String
showSeq open strs close = open ++ intercalate "," strs ++ close



-- | A 'Map' lookup that treats undefined keys as mapping to empty lists.
(!!!) :: Ord a => Map a [b] -> a -> [b]
m !!! a = case Map.lookup a m of
    Just as -> as
    _       -> []

-- | Inverts a 'Map'. The argument map may have several keys mapping to the same
-- element, so the inverted map has a list of elements for each key.
invertMap :: (Ord a, Ord b) => Map a b -> Map b [a]
invertMap m = Map.fromListWith (++) [(b,[a]) | (a,b) <- Map.toList m]



-- | Topological sort. Lists the nodes in the map such that each node appears
-- before its children. The function only terminates for acyclic maps.
topSort :: Ord a => Map a [a] -> [a]
topSort = reverse . evalState sorter
  where
    findLeaf a = do
      dag <- get
      let bs = [b | b <- dag Map.! a, Just _ <- [Map.lookup b dag]]
      case bs of
        []  -> modify (Map.delete a) >> return a
        b:_ -> findLeaf b

    sorter = do
        dag <- get
        if Map.null dag
           then return []
           else do
             let (a,_) = Map.elemAt 0 dag
             leaf <- findLeaf a
             liftM (leaf:) sorter

  -- XXX It might be slightly inefficient to always restart findLeaf at the
  --     first element (which can be considered a random node in the dag). It
  --     would probably be better to restart at the parent of the last leaf.

  -- XXX QuickCheck?