{-# OPTIONS_GHC -fglasgow-exts #-}

-- TextTable.hs
-- Defines a TextTable type, which defines a map of strings to a record
-- of text fields.

module TextTable(TextTable(..),TextRecord,makeTable,lookupRecord,listKeys,listRecords) where

import Prelude hiding (putStr,putStrLn,readFile,lines)
import qualified Data.ByteString.Lazy as BSL (ByteString)
import Data.Array.Unboxed
import Data.HashTable (HashTable)
import Data.List hiding (lines)
import Data.Map (Map,fromList)
import qualified Data.HashTable as HT
import Test.HUnit
import AbsString

data TextTable s = TextTable { tableFields :: ![s],
                               keyFieldIndex :: !Int,
                               tableRecords :: !(HashTable s (Array Int s)) }

type TextRecord s = Map s s

makeTable :: AbsString s => String -> String -> s -> IO (TextTable s)
makeTable fileName keyField text = do
  putStrLn ("Reading table from '" ++ fileName ++ "'...")
  let (headerLine:recordLines) = lines text
  let fields = split '|' headerLine
  let nFields = length fields
  let (Just keyIndex) = elemIndex (s keyField) fields
  let records = map (split '|') recordLines
  putStrLn "Fields:"
  mapM_ (\f -> putStr (if (f==s keyField) then "* " else "  ") >> putStr f >> putStr "\n") fields
  table <- HT.new (==) (HT.hashString . toString)
  putStrLn "Reading records..."
  sequence_ [do if (i `mod` 100 == 0) then putStr "." else return ()
                if (i `mod` 5000 == 0) then putStr (show i ++ "\n") else return ()
                if not (null r) then HT.insert table (r !! keyIndex) (listArray (0,nFields-1) r) else return ()
             | (i,r) <- zip [1..] records]
  putStrLn "\nDone reading table."
  return (TextTable fields keyIndex table)

lookupRecord :: AbsString s => TextTable s -> s -> IO (Maybe (TextRecord s))
lookupRecord (TextTable fields _ records) keyValue = do
  maybeRecord <- HT.lookup records keyValue
  return $ do record <- maybeRecord
              return (fromList (zip fields (elems record)))

listKeys :: AbsString s => TextTable s -> IO [s]
listKeys (TextTable fields keyField records) = do
  keyRecs <- HT.toList records
  return $ map fst keyRecs

listRecords :: AbsString s => TextTable s -> IO [TextRecord s]
listRecords (TextTable fields _ records) = do
  keyRecs <- HT.toList records
  return $ map (fromList . zip fields . elems . snd) keyRecs

test_readTable = TestCase $ do
  let text = "name|id\n"
             ++ "Warts and All|324\n"
             ++ "Rose Garden|123\n"
  table <- makeTable "<test>" "id" (s text :: BSL.ByteString)
  maybeRecord <- lookupRecord table (s "123")
  assertEqual "" (Just (fromList [(s "name", s "Rose Garden"),(s "id", s "123")])) maybeRecord
  
runTests = runTestTT $ TestList [TestLabel "test_readTable" test_readTable]