module HsDev.Server.Message.Lisp (
	Msg,
	isLisp, msg,
	jsonMsg, lispMsg,

	decodeMsg, encodeMsg
	) where

import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Aeson
import Data.Maybe
import Data.ByteString.Lazy.Char8 (ByteString)

import Data.Lisp

type Msg a = (Bool, a)

isLisp :: Lens' (Msg a) Bool
isLisp = _1

msg :: Lens (Msg a) (Msg b) a b
msg = _2

jsonMsg :: a -> Msg a
jsonMsg = (,) False

lispMsg :: a -> Msg a
lispMsg = (,) True

-- | Decode lisp or json
decodeMsg :: FromJSON a => ByteString -> Either (Msg String) (Msg a)
decodeMsg bstr = over _Left decodeType' decodeMsg' where
	decodeType'
		| isLisp' = lispMsg
		| otherwise = jsonMsg
	decodeMsg' = (lispMsg <$> decodeLisp bstr) <|> (jsonMsg <$> eitherDecode bstr)
	isLisp' = fromMaybe False $ mplus (try' eitherDecode False) (try' decodeLisp True)
	try' :: (ByteString -> Either String Value) -> Bool -> Maybe Bool
	try' f l = either (const Nothing) (const $ Just l) $ f bstr

-- | Encode lisp or json
encodeMsg :: ToJSON a => Msg a -> ByteString
encodeMsg m
	| view isLisp m = encodeLisp $ view msg m
	| otherwise = encode $ view msg m