{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

-- |
-- Module      :  System.Terminfo.DBParse
-- Copyright   :  (c) Bryan Richter (2013)
-- License     :  BSD-style
-- 
-- Maintainer  :  bryan.richter@gmail.com
--
-- An internal module encapsulating methods for parsing a terminfo file as
-- generated by tic(1). The primary reference is the term(5) manpage.
--

module System.Terminfo.DBParse
    ( parseDB
    ) where

#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Arrow ((***))
import qualified Control.Arrow as Arr
import Control.Monad ((<=<), when, void)
import Data.Attoparsec.ByteString as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (chr)
import qualified Data.Map.Lazy as M
import Data.Word (Word16)

import System.Terminfo.Types

-- | term(5) defines a short integer as two 8-bit bytes, so:
type ShortInt = Word16

-- | short ints are stored little-endian.
shortInt :: Integral a => ShortInt -> Parser a
shortInt i = word8 first >> word8 second >> return (fromIntegral i)
  where
    (second, first) = (fromIntegral *** fromIntegral) $ i `divMod` 256

-- | short ints are stored little-endian.
--
-- (-1) is represented by the two bytes 0o377 0o377.
--
-- Return type is Int so I can include (-1) in the possible outputs. I
-- wonder if I will regret this.
anyShortInt :: Parser Int
anyShortInt = do
    first <- fromIntegral <$> anyWord8
    second <- fromIntegral <$> anyWord8
    return $ if first == 0o377 && second == 0o377
       then (-1)
       else 256*second + first

parseDB :: ByteString -> Either String TIDatabase
parseDB = parseOnly tiDatabase

tiDatabase :: Parser TIDatabase
tiDatabase = do
    Header{..} <- header
    -- Ignore names
    _ <- A.take namesSize
    bools <- boolCaps boolSize
    -- Align on an even byte
    when (odd boolSize) (void $ A.take 1)
    nums <- numCaps numIntegers
    strs <- stringCaps numOffsets stringSize
    -- TODO: extended info
    return $ TIDatabase bools nums strs

boolCaps :: Int -- ^ Number of caps
         -> Parser TCBMap
boolCaps =
    return . TCBMap . M.fromList . zip keys . map (== 1) . B.unpack
        <=< A.take
  where
    {-keys :: [BoolTermCap]-}
    keys = [minBound ..]

-- Negative values indicate missing capability.
numCaps :: Int -- ^ Number of caps
        -> Parser TCNMap
numCaps = return . TCNMap . M.fromList . filter notNeg . zip keys
    <=< flip A.count anyShortInt
  where
    notNeg = ((/= -1) . snd)
    {-keys :: [BoolTermCap]-}
    keys = [minBound ..]

stringCaps :: Int -- ^ Number of caps
           -> Int -- ^ Size of table
           -> Parser TCSMap
stringCaps numOffsets stringSize = do
    offs <- A.count numOffsets anyShortInt
    stringTable <- A.take stringSize
    return
        $ TCSMap $ M.fromList $ map (parseValue stringTable)
        $ filter notNeg $ zip keys offs
  where
    notNeg = ((/= -1) . snd)
    keys = [minBound ..]
    parseValue tbl = Arr.second $ parseString tbl
    parseString table offset =
        asString
        $ B.takeWhile (/= 0)  -- null-terminated
        $ B.drop offset table -- starts at offset
    asString = map (chr . fromIntegral) . B.unpack

-- | the magic number for term files
magic :: Parser Int
magic = shortInt 0o432 <?> "Not a terminfo file (bad magic)"

data Header = Header
     { namesSize :: !Int
     , boolSize :: !Int
     , numIntegers :: !Int
     , numOffsets :: !Int
     , stringSize :: !Int
     }
     deriving (Show)

header :: Parser Header
header = magic >> Header <$> anyShortInt
                         <*> anyShortInt
                         <*> anyShortInt
                         <*> anyShortInt
                         <*> anyShortInt