module Glob
where

import Slurp

import Data.Char
import Data.List
import Control.Monad
import Control.Monad.State

import Data.Map	(Map)
import qualified Data.Map	as Map

import Debug.Trace


-- | Trace through this sequence and see what bits we have
--	If we have a _srt _closure or _info for the same bit then 
--	we're going to glob them together.
--
diagSeq :: Seq	-> Map String [String]
diagSeq seq	= diagSeq' Map.empty seq

diagSeq' :: Map String [String] -> [String] -> Map String [String]
diagSeq' map []		= map
diagSeq' map (x:xs)
 = case splitName x of
 	Just (name, suffix)
	 -> let map'	= Map.alter
			 	(\mes -> case mes of
					Nothing	-> Just [suffix]
					Just es	-> Just $ es ++ [suffix])
				name
				map
	    in diagSeq' map' xs

	Nothing
	 -> let map'	= Map.insert x [] map
	    in	diagSeq' map' xs
	 
expandDiag :: Map String [String] -> [[String]]
expandDiag diag
 = 	[ [ k ++ p | p <- ps] 
	| (k, ps) <- Map.toList $ diag ]
	 

-- | See if this name is one we're looking for.
--	name_info
--	name_closure
--	name_srt
--
splitName :: String -> Maybe (String, String)
splitName str
 	| Just name	<- stripSuffix "_info:" str
	= Just (name, "_info:")

 	| Just name	<- stripSuffix "_closure:" str
	= Just (name, "_closure:")

 	| Just name	<- stripSuffix "_srt:" str
	= Just (name, "_srt:")
	
	| otherwise
	= Nothing


-- | Glob together the bits from the variaous _info _closure and _srt parts.
--	Put them next to eachother so they're easier to swap around.
--
glob :: [[String]] -> Bits -> Bits
glob []     bits	= bits
glob (n:ns) bits	= glob ns (glob' n bits)
 

glob' :: [String] -> Bits -> Bits

glob' [] bits	= bits
glob' [n] bits	= bits

glob' ns bits
 = let	bitss :: [[String]]
 	Just bitss	= sequence 
			$ map ((flip Map.lookup) bits) ns
  	
	-- delete all the bits from the map
	bits2		= foldr Map.delete bits ns

	-- choose a new name and make the new bit
	name		= chooseName ns
	bitOut		= concat bitss

	-- insert new bit into the map
	bits3		= Map.insert name bitOut bits2

   in	bits3


-- | Chose a name for a bit, from several options
chooseName :: [String] -> String
chooseName ns@(n:_)
 = let	mClosure	= takeFirstJust $ map (stripSuffix "closure:")	ns
 	mInfo		= takeFirstJust $ map (stripSuffix "info:")	ns
	mSrt		= takeFirstJust $ map (stripSuffix "srt:")	ns
 
	result
		| Just c	<- mClosure	= c ++ "closure:"
		| Just c	<- mInfo	= c ++ "info:"
		| Just c	<- mSrt		= c ++ "srt:"
		| otherwise			= n

   in	result


-- | Decide which way to do the merge.
--	We keep one of the names to label the resulting bit
mergeIt :: String -> String 
	-> Maybe ( String	-- name for resulting bit
		 , String)	-- not the name 
		 
mergeIt s1 s2
 = case comp s1 s2 of
 	(same, "closure:", "srt:")	-> Just (s1, s2)
 	(same, "srt:",     "closure:")	-> Just (s2, s1)

	(same, "closure:", "info:")	-> Just (s2, s1)
	(same, "info:",    "closure:")	-> Just (s1, s2)

	(same, "srt:",     "info:")	-> Just (s2, s1)
	(same, "info:",    "srt:")	-> Just (s1, s2)
	_				-> Nothing



--------------------------------------------------------------------------------
comp :: Eq a => [a] -> [a] -> ([a], [a], [a])
comp (x:xs) (y:ys)
	| x == y	
	= let 	(same, left, right)	= comp xs ys
	  in	(x:same, left, right)
	  
	| otherwise
	= ([], x:xs, y:ys)


stripSuffix :: String -> String -> Maybe String
stripSuffix suff str
	= liftM reverse 
	$ stripPrefix (reverse suff) (reverse str)
	
takeFirstJust :: [Maybe a] -> Maybe a
takeFirstJust xx
 = case xx of
 	[]		-> Nothing
	(Just x  : xs)	-> Just x
	(Nothing : xs)	-> takeFirstJust xs