module Prog(prog) where

-- ************** SeqSer *************

-- strictly serial search
-- sequential

--partain:import Libfuns
import Auxil
import Key
import Data.List (intersperse)

prog :: Int -> String
prog n = show (cichelli n)

data Status a = NotEver Int | YesIts Int a deriving ()
instance (Show a) => Show (Status a) where
    showsPrec d (NotEver i) = showParen (d >= 10) showStr
      where
	showStr = showString "NotEver" . showChar ' ' . showsPrec 10 i

    showsPrec d (YesIts i a) = showParen (d >= 10) showStr
      where
	showStr = showString "YesIts" . showChar ' ' . showsPrec 10 i
		  . showChar ' ' . showsPrec 10 a

--  readsPrec p = error "no readsPrec for Statuses"
--  readList = error "no readList for Statuses"
    showList []	= showString "[]"
    showList (x:xs)
		= showChar '[' . shows x . showl xs
		  where showl []     = showChar ']'
			showl (x:xs) = showChar ',' . shows x . showl xs

type FeedBack = Status HashFun

cichelli :: Int -> FeedBack
cichelli n = findhash hashkeys
                where
-- #ifdef SORTED
		attribkeys' = attribkeys (keys ++ take (n `mod` 2) keys)
                hashkeys = (blocked.freqsorted) attribkeys'
-- #else
--                hashkeys = blocked attribkeys
-- #endif


findhash :: [Key] -> FeedBack
findhash = findhash' (H Nothing Nothing []) []


findhash' :: HashSet -> HashFun -> [Key] -> FeedBack
findhash' keyHashSet charAssocs [] = (YesIts 1 charAssocs)
findhash' keyHashSet charAssocs (k@(K s a z n):ks) =
  ( case (assocm a charAssocs, assocm z charAssocs) of
	  (Nothing,Nothing) -> if a==z then
				firstSuccess (\m->try [(a,m)]) [0..maxval]
				else
				firstSuccess (\(m,n)->try [(a,m),(z,n)])
					    [(m,n) | m<-[0..maxval], n<-[0..maxval]]
          (Nothing,Just zc) -> firstSuccess (\m->try [(a,m)]) [0..maxval]
	  (Just ac,Nothing) -> firstSuccess (\n->try [(z,n)]) [0..maxval]
	  (Just ac,Just zc) -> try [] )
  where
  try newAssocs = ( case hinsert (hash newCharAssocs k) keyHashSet of
             Nothing -> (NotEver 1)
             Just newKeyHashSet -> findhash' newKeyHashSet newCharAssocs ks )
             where
             newCharAssocs = newAssocs ++ charAssocs

-- Returns the first successful `working' function on a list of possible arguments
firstSuccess :: (a -> FeedBack) -> [a] -> FeedBack
firstSuccess f possibles =  first 0 (map f possibles)

first :: Int -> [FeedBack] -> FeedBack
first k [] = NotEver k
first k (a:l) = case a of
                (YesIts leaves y) -> YesIts (k+leaves) y
                (NotEver leaves)    -> first (k+leaves) l
