module Main where

import qualified Data.Map as Map
import Data.Map(Map)
import System.Random(Random, RandomGen, randomR, randomRs, getStdGen, split, )
import Control.Monad.State(State, state, runState, evalState, )

main :: IO ()
main = do
  dictfirst  <- readFile "vornamen.txt"
  dictsecond <- readFile "nachnamen.txt"
  {-
    putStrLn ("sizes of dictionaries: " ++
      show (map (\n -> (n, Map.size (createMap n dictfirst))) [1,2,3,4]))
  -}
  g <- getStdGen
  putStrLn ("<UL>\n"++(createEmailAddrs g 10 2 dictfirst dictsecond)++"</UL>\n")
--  putStrLn (show (take 20 (walk 3 dictfirst g)))

createEmailAddrs :: RandomGen g =>
   g -> Int -> Int -> [Char] -> [Char] -> [Char]
createEmailAddrs g num mem dictfirst dictsecond =
   let (g1,gt) = split g
       (g2,g3) = split gt
   in concat (take num (
	zipWith3
	  (\n1 n2 dom ->
	    "<LI><A href=\"mailto:"++n1++"."++n2++"@"++dom++".de\">"++
            n1++" "++n2++"</A></LI>\n")
	  (lines (walk mem dictfirst g1))
          (lines (walk mem dictsecond g2))
	  (randomDomainList g3)))

randomDomainList :: RandomGen g => g -> [String]
randomDomainList g =
   let (g0,g1) = split g
   in  randomChop g0 (randomRs ('a','z') g1)

{- Chop a list into pieces of random length -}
randomChop :: RandomGen g => g -> [a] -> [[a]]
randomChop g =
   evalState (mapM (state . splitAt) (randomRs (5,10) g))

{- creates a chain of characters according
   to the probabilities of possible successor -}
walk :: RandomGen g => Int -> [Char] -> g -> String
walk n    -- size of look-ahead buffer
     dict -- text to walk through randomly
     g    -- random generator state
   = let fm = createMap n dict
         (start,ng) = runState (randomStart dict) g
         {- This is the main function of this program.
            It is quite involved.
            If you want to understand it,
            imagine the list 'y' completely exists
            before computation. -}
         y = take n start ++
               -- run them on the initial random generator state
               (flip evalState ng $
                -- this turns the list of possible successors
                -- into an action that generate a list
                -- of randomly chosen items
                mapM randomItem $
                -- lookup all possible successors of each infix
                map (flip (Map.findWithDefault (error "each infix found in the text must also be in the dictionary")) fm) $
                -- wrap the suffixes in the BoundList data structure
                -- this is similar to (take n)
                map (BoundList n) $
                -- list all suffixes of y
                iterate tail y)
     in  y


randomStart :: (RandomGen g) => [Char] -> State g String
randomStart dict = randomItem (startingPoints '\n' dict)

-- chose a random item from a list
randomItem :: (RandomGen g) => [a] -> State g a
randomItem x = fmap (x!!) (state (randomR (0, length x - 1)))


startingPoints :: (Eq a) => a -> [a] -> [[a]]
startingPoints sep dict =
   map tail (filter ((sep==).head) (takeWhile (not.null) (iterate tail dict)))

-- create a map that lists for each string all possible successors
createMap :: (Ord a) => Int -> [a] -> Map (BoundList a) [a]
-- (flip (++)) should be a bit faster than (++)
-- since it prepends new entries
createMap n x =
   let -- list of the map keys
       sufxs   = map (BoundList n) (iterate tail (cycle x))
       -- list of the map images, i.e. single element lists
       imgxs   = map (:[]) (drop n (cycle x))
       maplist = take (length x) (zip sufxs imgxs)
   in  Map.fromListWith (flip (++)) maplist

-- BoundList is a virtually finite list
{- The contained list must be infinite and
   the integer specifies the length of the prefix
   of the list to be considered.
   This treatment is much more efficient
   than actually splitting the list (with 'take')
   since no part of the splitted list must be copied. -}
data BoundList a = BoundList !Int ![a]
--       deriving Show


instance Show a => Show (BoundList a) where
   show (BoundList n x) = show (take n x) ++ "..."

instance Eq a => Eq (BoundList a) where
   (BoundList n x) == (BoundList m y) =
      if n==m
        then and (take n (zipWith (==) x y))
        else error "(==): Length of BoundLists must be equal!"

instance Ord a => Ord (BoundList a) where
   compare (BoundList 0 _) (BoundList 0 _) = EQ
   compare (BoundList 0 _) (BoundList _ _) = error "compare: Length of BoundLists must be equal!"
   compare (BoundList _ _) (BoundList 0 _) = error "compare: Length of BoundLists must be equal!"
   compare (BoundList n (x:xs)) (BoundList m (y:ys)) =
      let rel = compare x y
      in  if rel == EQ
            then compare (BoundList (n-1) xs) (BoundList (m-1) ys)
            else rel