module Rattletrap.Type.Common
  ( Int.Int8
  , Int.Int32
  , Int.Int64
  , Map.Map
  , Text.Text
  , Word.Word8
  , Word.Word16
  , Word.Word32
  , Word.Word64
  , deriveJson
  )
where

import qualified Data.Aeson as Json
import qualified Data.Aeson.TH as Json
import qualified Data.Char as Char
import qualified Data.Int as Int
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Word as Word
import qualified Language.Haskell.TH as TH

deriveJson :: TH.Name -> TH.Q [TH.Dec]
deriveJson :: Name -> Q [Dec]
deriveJson Name
name = Options -> Name -> Q [Dec]
Json.deriveJSON (String -> Options
jsonOptions (Name -> String
TH.nameBase Name
name)) Name
name

jsonOptions :: String -> Json.Options
jsonOptions :: String -> Options
jsonOptions String
prefix = Options
Json.defaultOptions
  { constructorTagModifier :: String -> String
Json.constructorTagModifier = String -> String
toSnakeCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. (Eq a, Show a) => [a] -> [a] -> [a]
partialDropPrefix String
prefix
  , fieldLabelModifier :: String -> String
Json.fieldLabelModifier = String -> String
toSnakeCase
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. (Eq a, Show a) => [a] -> [a] -> [a]
partialDropPrefix (String -> String
lowerFirst String
prefix)
  , omitNothingFields :: Bool
Json.omitNothingFields = Bool
True
  , sumEncoding :: SumEncoding
Json.sumEncoding = SumEncoding
Json.ObjectWithSingleField
  , unwrapUnaryRecords :: Bool
Json.unwrapUnaryRecords = Bool
True
  }

lowerFirst :: String -> String
lowerFirst :: String -> String
lowerFirst String
string = case String
string of
  String
"" -> String
string
  Char
first : String
rest -> Char -> Char
Char.toLower Char
first Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest

toSnakeCase :: String -> String
toSnakeCase :: String -> String
toSnakeCase = Char -> String -> String
Json.camelTo2 Char
'_'

partialDropPrefix :: (Eq a, Show a) => [a] -> [a] -> [a]
partialDropPrefix :: [a] -> [a] -> [a]
partialDropPrefix [a]
prefix [a]
list = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
Maybe.fromMaybe
  (String -> [a]
forall a. HasCallStack => String -> a
error ([String] -> String
unwords [[a] -> String
forall a. Show a => a -> String
show [a]
prefix, String
"is not a prefix of", [a] -> String
forall a. Show a => a -> String
show [a]
list]))
  ([a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
dropPrefix [a]
prefix [a]
list)

dropPrefix :: Eq a => [a] -> [a] -> Maybe [a]
dropPrefix :: [a] -> [a] -> Maybe [a]
dropPrefix [a]
prefix [a]
list = case [a]
prefix of
  [] -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
list
  a
ph : [a]
pt -> case [a]
list of
    [] -> Maybe [a]
forall a. Maybe a
Nothing
    a
lh : [a]
lt -> if a
ph a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lh then [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
dropPrefix [a]
pt [a]
lt else Maybe [a]
forall a. Maybe a
Nothing