{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}

module Data.JSON
    ( fromJson
    , fromJson'
    , toJson
    ) where

import           Data.Aeson
import           Data.Aeson.Encoding
import           Data.Aeson.Text      (encodeToLazyText)
import           Data.Aeson.Types
import           Data.ByteString.Lazy (ByteString)
import           Data.IntMap          (IntMap)
import qualified Data.IntMap          as IMap
import           Data.Text.Lazy       (Text)
import qualified Data.Text.Lazy       as Text
import qualified Data.Vector          as Vector
import           Text.Casing

import qualified Data.Scientific      as Scientific (toBoundedInteger)

import           Data.NonEmptyList    as NonEmptyList
import           Data.PrintableText

import           Control.Lens         hiding ((.=))

import           AlBhed
import           AlBhed.Index         (IndexItem (..), _IndexItem)
import           Location

fromJson :: FromJSON a => ByteString -> Maybe a
fromJson = decode

fromJson' :: FromJSON a => ByteString -> Either String a
fromJson' = eitherDecode

toJson :: ToJSON a => a -> Text
toJson = encodeToLazyText

jsonOptions :: Options
jsonOptions = defaultOptions
    { fieldLabelModifier = camel . drop 1
    , omitNothingFields = True
    }

instance ToJSON Location where
    toEncoding = genericToEncoding jsonOptions

instance FromJSON Location where
    parseJSON = genericParseJSON jsonOptions

instance ToJSON Volume where
    toJSON = Number . fromIntegral . fromVolume
    toEncoding = int . fromVolume

instance FromJSON Volume where
    parseJSON (Number x) =
        let maybeVolume = Scientific.toBoundedInteger x >>= toVolume
        in case maybeVolume of
            Just vol -> pure vol
            Nothing  -> fail "Volume number is out of bounds"
    parseJSON _ = fail "Volume must be a number"

instance ToJSON Primer where
    toEncoding = genericToEncoding jsonOptions

instance FromJSON Primer where
    parseJSON = genericParseJSON jsonOptions

instance ToJSON a => ToJSON (NonEmptyList a) where
    toEncoding list =
        let (x, xs) = NonEmptyList.uncons list
            in toEncoding (x:xs)

instance FromJSON a => FromJSON (NonEmptyList a) where
    parseJSON = withArray "NonEmptyList" $ \array ->
        maybe (fail "Unable to parse values") pure (parseValues array)
        where
            parseVec = sequence . Vector.toList . Vector.map fromJSON
            parseValues array = Vector.uncons array >>=
                \(head, tail) -> case (fromJSON head, parseVec tail) of
                    (Success x, Success xs) -> fromList (x:xs)
                    _                       -> fail "Unable to parse values"

instance ToJSON PrintableText where
    toJSON = toJSON . unPrintableText
    toEncoding = toEncoding . unPrintableText

instance FromJSON PrintableText where
    parseJSON = withText "PrintableText" $ \text ->
        maybe (fail "Text contains only spaces") pure (fromText text)

instance ToJSON IndexItem where
    toJSON value =
        let (primer, xs) = value ^. _IndexItem
            in object ["primer" .= primer, "locations" .= xs]
    toEncoding value =
        let (primer, xs) = value ^. _IndexItem
            in pairs ("primer" .= primer <> "locations" .= xs)

instance FromJSON IndexItem where
    parseJSON = withObject "IndexItem" $ \value ->
        let item = (,) <$> value .: "primer" <*> value .: "locations"
            in IndexItem <$> item

instance {-# OVERLAPPING #-} FromJSON (IntMap IndexItem) where
    parseJSON = withArray "AlBhed.Index" parseValues
        where
            parseVec = sequence . Vector.toList . Vector.map fromJSON
            parseValues array = case parseVec array of
                Success x -> pure . IMap.fromList . map (\item@(IndexItem (primer, _)) -> (primer ^. volume & fromVolume, item)) $ x
                _ -> fail "Unable to parse values"

instance {-# OVERLAPPING #-} ToJSON (IntMap IndexItem) where
    toJSON = toJSON . IMap.elems
    toEncoding = toEncoding . IMap.elems