Data.Aeson.Golang.hs

{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE UndecidableInstances       #-}


module Data.Aeson.Golang where

import           Control.Applicative (Alternative)
import           Control.Lens
import           Data.Aeson
import qualified Data.Char
import           Data.Coerce
import qualified Data.List
import qualified Data.Text    as T
import           GHC.Generics


-- | Golang types are typically capitalized, which isn't valid for Haskell
-- field names. So to support this, we allow the Haskell code to prefix a
-- capitalized field name with an underscore, and we remove the underscore
-- when parsing JSON.
--
-- This type is meant for use with @-XDerivingVia@
newtype GolangJSON a = GolangJSON { unGolangJSON :: a }

golangJSONOptions :: Options
golangJSONOptions = defaultOptions
  { fieldLabelModifier = \s ->
      let stripped = takeWhile (/= '_') $ dropWhile (== '_') s
       in if "_" `Data.List.isPrefixOf` s
          then stripped
          else titleStr stripped
  }


titleStr :: String -> String
titleStr []     = []
titleStr (x:xs) = Data.Char.toUpper x : xs

instance (Generic a, GToJSON Zero (Rep a), GToEncoding Zero (Rep a)) => ToJSON (GolangJSON a) where
  toJSON     = genericToJSON golangJSONOptions . unGolangJSON

instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (GolangJSON a) where
  parseJSON = fmap GolangJSON . genericParseJSON golangJSONOptions

newtype GolangOptional a = GolangOptional { unGolangOptional :: Maybe a }
  deriving stock (Eq, Ord, Show, Read, Functor, Foldable, Traversable)
  deriving newtype (Applicative, Alternative, Monad)

type GolangMaybe a = Maybe (GolangOptional a )

_GoJust :: Prism (GolangMaybe a) (GolangMaybe b) a b
_GoJust = _Just . _GoNonZero

_GoNonZero :: Prism (GolangOptional a) (GolangOptional b) a b
_GoNonZero = prism (GolangOptional . Just) $ (maybe (Left (GolangOptional Nothing)) Right . unGolangOptional)

instance FromJSON a => FromJSON (GolangOptional a) where
  parseJSON = let no = pure $ GolangOptional Nothing in \case
    String str | T.null str -> no
    Array  arr |   null arr -> no
    Object obj |   null obj -> no
    Null                    -> no
    v -> GolangOptional . Just <$> parseJSON @a v

instance (Coercible a T.Text, ToJSON a) => ToJSON (GolangOptional a) where
  toJSON = \case
    GolangOptional Nothing -> String ""
    GolangOptional (Just a) -> toJSON a