{-# LANGUAGE OverloadedStrings #-}

module Parser
( parseKeychain
, parseKeychainList
, runParser
) where

import Types
import Control.Applicative
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Char8 (pack, unpack)
import Data.Hex              (unhex)
import Data.Time


runParser :: Monoid a => Parser a -> String -> a
runParser parser = handle . parseOnly parser . pack
  where
    handle (Left  _) = mempty
    handle (Right x) = x


-- Parsers --

parseKeychain :: Parser Keychain
parseKeychain = many item

parseKeychainList :: Parser [FilePath]
parseKeychainList = many $
  between (many space >> quote) quote anyChar

item :: Parser Item
item = do
  string "keychain: "
  path <- quoted
  endOfLine
  string "class: "
  class_ <- iclass <|> sclass
  endOfLine
  string "attributes:"
  endOfLine
  attrs <- many entry
  endOfLine
  string "data:"
  endOfLine
  raw <- raw  <|> hex' <|>
         raw' <|> pure "" <* endOfLine
  return Item { keychain  = path
              , itemClass = class_
              , attrs     = attrs 
              , content   = raw }

entry :: Parser Attrib
entry = do
  many space
  name <- eitherP quoted hex
  between (char '<') (char '>') anyChar
  char '='
  val <- value
  return (name, val)

value :: Parser Value
value =
  pure Null <$> string "<NULL>" <|>
  Date      <$> date            <|>
  Str       <$> quoted          <|>
  Str       <$> quoted'         <|>
  Num       <$> hex


sclass :: Parser ItemClass
sclass = do
  quote
  name <- str
  quote
  return name
  where
    str = pure Inet <*  string "inet" <|>
          pure Genp <*  string "genp"

iclass :: Parser ItemClass
iclass = Id <$> hex


-- Parser helpers --

between :: Parser a -> Parser b -> Parser c -> Parser [c]
between p q x = p >> manyTill x q

hex :: Parser Integer
hex = do
  string "0x"
  num <- hexadecimal
  space
  return num

-- decoded hex string
hex' :: Parser String
hex' =
  between (string "0x") (space >> endOfLine) anyChar >>= unhex

quote :: Parser Char
quote = char '"'

-- literal string
quoted :: Parser String
quoted = between quote quote anyChar

-- hex followed by string version
quoted' :: Parser String
quoted' = hex >> space >> quoted

-- unescaped string
raw :: Parser String
raw = between quote (quote >> endOfLine) anyChar

-- hex followed by unescaped string
raw' :: Parser String
raw' = hex >> space >> raw

digits :: Read a => Int -> Parser a
digits n = read <$> count n digit

date :: Parser LocalTime
date = do
  hex >> space >> quote
  year  <- digits 4
  month <- digits 2
  day   <- digits 2
  hour  <- digits 2
  min   <- digits 2
  sec   <- digits 2
  string "Z\\" >> decimal >> quote
  return LocalTime { localDay = fromGregorian year month day
                   , localTimeOfDay = TimeOfDay hour min sec }