-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE OverloadedStrings #-}

module Data.ByteString.From
    ( FromByteString (..)
    , runParser
    ) where

import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString
import Data.Attoparsec.ByteString.Char8 (signed, decimal, hexadecimal, double)
import Data.Bits (Bits)
import Data.ByteString (ByteString, elem)
import Data.Int
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8')
import Data.Word
import Prelude hiding (elem)

import qualified Data.ByteString.Lazy as Lazy

-- | Parse 'ByteString's as typed values.
--
-- Minimal complete definition: 'parser'.
class FromByteString a where
    parser :: Parser a

    fromByteString :: ByteString -> Maybe a
    fromByteString = either (const Nothing) Just . runParser parser

runParser :: Parser a -> ByteString -> Either String a
runParser p b = case feed (parse p b) "" of
    Done ""  r -> Right r
    Done _   _ -> Left "Trailing input"
    Fail _ _ m -> Left m
    Partial _  -> Left "Unexpected result: Partial"

-----------------------------------------------------------------------------
-- Instances

instance FromByteString ByteString where
    parser = takeByteString

instance FromByteString Lazy.ByteString where
    parser = takeLazyByteString

-- | A (flat) comma-separated list of values without spaces.
instance FromByteString a => FromByteString [a] where
    parser = parseList

-- | UTF-8 is assumed as encoding format.
instance FromByteString Text where
    parser = takeByteString >>= text

instance FromByteString Bool where
    parser =
        satisfy (`elem` "tT") *> string "rue"  *> pure True  <|>
        satisfy (`elem` "fF") *> string "alse" *> pure False <|>
        fail "Invalid Bool"

instance FromByteString Double where
    parser = signed double <|> fail "Invalid Double"

instance FromByteString Integer where
    parser = hexLiteral <|> fail "Invalid Integer"

instance FromByteString Int where
    parser = hexLiteral <|> fail "Invalid Int"

instance FromByteString Int8 where
    parser = hexLiteral <|> fail "Invalid Int8"

instance FromByteString Int16 where
    parser = hexLiteral <|> fail "Invalid Int16"

instance FromByteString Int32 where
    parser = hexLiteral <|> fail "Invalid Int32"

instance FromByteString Int64 where
    parser = hexLiteral <|> fail "Invalid Int64"

instance FromByteString Word where
    parser = hexLiteral <|> fail "Invalid Word"

instance FromByteString Word8 where
    parser = hexLiteral <|> fail "Invalid Word8"

instance FromByteString Word16 where
    parser = hexLiteral <|> fail "Invalid Word16"

instance FromByteString Word32 where
    parser = hexLiteral <|> fail "Invalid Word32"

instance FromByteString Word64 where
    parser = hexLiteral <|> fail "Invalid Word64"

-----------------------------------------------------------------------------
-- Implementation Helpers

parseList :: FromByteString a => Parser [a]
parseList = atEnd >>= \e ->
    if e then return []
         else reverse <$> go []
  where
    go acc = do
        x <- takeTill (== 0x2C)
        v <- case runParser parser x of
                Left  s -> fail s
                Right a -> return a
        c <- optional (word8 0x2C)
        e <- atEnd
        case (e, isJust c) of
            (True,  True)  -> fail "trailing comma"
            (True,  False) -> return (v:acc)
            (False, True)  -> go (v:acc)
            (False, False) -> fail "missing comma"

text :: ByteString -> Parser Text
text = either (fail . ("Invalid UTF-8: " ++) . show) return . decodeUtf8'

hexLiteral :: (Integral a, Bits a) => Parser a
hexLiteral = signed (try hex <|> decimal)
  where
    hex = word8 0x30 *> satisfy (`elem` "xX") *> hexadecimal