{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Data.JSON.Schema.Generator.Convert
    ( convert
    ) where

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<*>))
import Data.Monoid (mappend)
#endif

import Data.JSON.Schema.Generator.Types (Schema(..), SchemaChoice(..))
import Data.Text (Text, pack)

import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector

--------------------------------------------------------------------------------

convert :: A.Options -> Schema -> A.Value
convert = convert' False

convert' :: Bool -> A.Options -> Schema -> A.Value
convert' = (((A.Object . HashMap.fromList) .) .) . convertToList

convertToList :: Bool -> A.Options -> Schema -> [(Text,A.Value)]
convertToList inArray opts s = foldr1 (++) $
    [ jsId
    , jsSchema
    , jsSchemaType           opts
    , jsTitle
    , jsDescription
    , jsReference
    , jsType         inArray opts
    , jsFormat
    , jsLowerBound
    , jsUpperBound
    , jsValue
    , jsItems                opts
    , jsProperties           opts
    , jsPatternProps         opts
    , jsOneOf                opts
    , jsRequired             opts
    , jsDefinitions          opts
    ] <*> [s]

--------------------------------------------------------------------------------

jsId :: Schema -> [(Text,A.Value)]
jsId (SCSchema {scId = i}) = [("id", string i)]
jsId _ = []

jsSchema :: Schema -> [(Text,A.Value)]
jsSchema SCSchema {scUsedSchema = s} = [("$schema", string s)]
jsSchema _ = []

jsSchemaType :: A.Options -> Schema -> [(Text,A.Value)]
jsSchemaType opts SCSchema {scSchemaType = s} = convertToList False opts s
jsSchemaType _ _ = []

jsTitle :: Schema -> [(Text,A.Value)]
jsTitle SCConst  {scTitle = "" } = []
jsTitle SCConst  {scTitle = t  } = [("title", string t)]
jsTitle SCObject {scTitle = "" } = []
jsTitle SCObject {scTitle = t  } = [("title", string t)]
jsTitle SCArray  {scTitle = "" } = []
jsTitle SCArray  {scTitle = t  } = [("title", string t)]
jsTitle SCOneOf  {scTitle = "" } = []
jsTitle SCOneOf  {scTitle = t  } = [("title", string t)]
jsTitle _ = []

jsDescription :: Schema -> [(Text,A.Value)]
jsDescription SCString  {scDescription = (Just d) } = [("description", string d)]
jsDescription SCInteger {scDescription = (Just d) } = [("description", string d)]
jsDescription SCNumber  {scDescription = (Just d) } = [("description", string d)]
jsDescription SCBoolean {scDescription = (Just d) } = [("description", string d)]
jsDescription SCConst   {scDescription = (Just d) } = [("description", string d)]
jsDescription SCObject  {scDescription = (Just d) } = [("description", string d)]
jsDescription SCArray   {scDescription = (Just d) } = [("description", string d)]
jsDescription SCOneOf   {scDescription = (Just d) } = [("description", string d)]
jsDescription _ = []

jsReference :: Schema -> [(Text,A.Value)]
jsReference SCRef {scReference = r} = [("$ref", string r)]
jsReference _ = []

jsType :: Bool -> A.Options -> Schema -> [(Text,A.Value)]
jsType (needsNull -> f) (f -> True) SCString  {scNullable = True } = [("type", array ["string", "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCString  {scNullable = _    } = [("type", string "string")]
jsType (needsNull -> f) (f -> True) SCInteger {scNullable = True } = [("type", array ["integer", "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCInteger {scNullable = _    } = [("type", string "integer")]
jsType (needsNull -> f) (f -> True) SCNumber  {scNullable = True } = [("type", array ["number", "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCNumber  {scNullable = _    } = [("type", string "number")]
jsType (needsNull -> f) (f -> True) SCBoolean {scNullable = True } = [("type", array ["boolean", "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCBoolean {scNullable = _    } = [("type", string "boolean")]
jsType (needsNull -> f) (f -> True) SCObject  {scNullable = True } = [("type", array ["object", "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCObject  {scNullable = _    } = [("type", string "object")]
jsType (needsNull -> f) (f -> True) SCArray   {scNullable = True } = [("type", array ["array",  "null" :: Text])]
jsType (needsNull -> f) (f -> _   ) SCArray   {scNullable = _    } = [("type", string "array")]
jsType _ _ _ = []

needsNull :: Bool -> A.Options -> Bool
needsNull True  _    = True
needsNull False opts = not (A.omitNothingFields opts)

jsFormat :: Schema -> [(Text,A.Value)]
jsFormat SCString {scFormat = Just f} = [("format", string f)]
jsFormat _ = []

jsLowerBound :: Schema -> [(Text,A.Value)]
jsLowerBound SCString {scLowerBound = (Just n)} = [("minLength", number n)]
jsLowerBound SCNumber {scLowerBound = (Just n)} = [("mininum",   number n)]
jsLowerBound SCArray  {scLowerBound = (Just n)} = [("minItems",  number n)]
jsLowerBound _ = []

jsUpperBound :: Schema -> [(Text,A.Value)]
jsUpperBound SCString {scUpperBound = (Just n)} = [("maxLength", number n)]
jsUpperBound SCNumber {scUpperBound = (Just n)} = [("maximum",   number n)]
jsUpperBound SCArray  {scUpperBound = (Just n)} = [("maxItems",  number n)]
jsUpperBound _ = []

jsValue :: Schema -> [(Text,A.Value)]
jsValue SCConst {scValue = v} = [("enum", array [v])]
jsValue _ = []

jsItems :: A.Options -> Schema -> [(Text,A.Value)]
jsItems opts SCArray {scItems = items} = [("items", array . map (convert' True opts) $ items)]
jsItems _ _ = []

jsProperties :: A.Options -> Schema -> [(Text,A.Value)]
jsProperties opts SCObject {scProperties = p} = [("properties", object $ toMap opts p)]
jsProperties _ _ = []

jsPatternProps :: A.Options -> Schema -> [(Text,A.Value)]
jsPatternProps _    SCObject {scPatternProps = []} = []
jsPatternProps opts SCObject {scPatternProps = p } = [("patternProperties", object $ toMap opts p)]
jsPatternProps _ _ = []

jsOneOf :: A.Options -> Schema -> [(Text,A.Value)]
jsOneOf opts SCOneOf {scChoices = cs, scNullable = nullable} = choices opts nullable cs
jsOneOf _ _ = []

jsRequired :: A.Options -> Schema -> [(Text,A.Value)]
jsRequired       A.Options {A.omitNothingFields = True}  SCObject {scRequired = r  } = [("required", array r)]
jsRequired opts@(A.Options {A.omitNothingFields = _   }) SCObject {scProperties = p} = [("required", array . map fst $ toMap opts p)]
jsRequired _ _ = []

jsDefinitions :: A.Options -> Schema -> [(Text,A.Value)]
jsDefinitions _    SCSchema {scDefinitions = []} = []
jsDefinitions opts SCSchema {scDefinitions = d } = [("definitions", object $ toMap opts d)]
jsDefinitions _ _ = []

--------------------------------------------------------------------------------

array :: A.ToJSON a => [a] -> A.Value
array = A.Array . Vector.fromList . map A.toJSON

string :: Text -> A.Value
string = A.String

number :: Integer -> A.Value
number = A.Number . fromInteger

object :: [A.Pair] -> A.Value
object = A.object

false :: A.Value
false = A.Bool False

--------------------------------------------------------------------------------

choices :: A.Options -> Bool -> [SchemaChoice] -> [(Text,A.Value)]
choices opts nullable cs
    | isEnum && nullable = [ ("oneOf", array $ [object [("enum", array $ map consAsEnum cs)], object [("type", string "null")]]) ]
    | isEnum             = [ ("enum", array $ map consAsEnum cs) ]
    | isUnit && nullable = [ ("type", array $ map string ["object", "null"])
                           , ("properties", head $ map (conAsObject opts) cs)
                           ]
    | isUnit             = [ ("type", array $ map string ["object"])
                           , ("properties", head $ map (conAsObject opts) cs)
                           ]
    | nullable           = [ ("oneOf", array $ object [("type", string "null")] : map (conAsObject opts) cs) ]
    | otherwise          = [ ("oneOf", array $ map (conAsObject opts) cs) ]
  where
    isEnum = A.allNullaryToStringTag opts && all enumerable cs
    isUnit = length cs == 1

enumerable :: SchemaChoice -> Bool
enumerable (SCChoiceEnum _ _) = True
enumerable _                  = False

consAsEnum :: SchemaChoice -> Text
consAsEnum (SCChoiceEnum tag _) = tag
consAsEnum s = error ("conAsEnum could not handle: " ++ show s)

conAsObject :: A.Options -> SchemaChoice -> A.Value
conAsObject opts@(A.Options {A.sumEncoding = A.TwoElemArray}) sc =
    object $
        if sctTitle sc == "" then [] else [ ("title", string $ sctTitle sc) ]
        `mappend`
        [ ("type", "array")
        , ("items" , conAsObject' opts sc)
        , ("minItems", number 2)
        , ("maxItems", number 2)
        , ("additionalItems", false)
        ]
conAsObject opts sc =
    object $
        if sctTitle sc == "" then [] else [ ("title", string $ sctTitle sc) ]
        `mappend`
        [ ("type", "object")
        , ("properties", conAsObject' opts sc)
        , ("additionalProperties", false)
        ]

conAsObject' :: A.Options -> SchemaChoice -> A.Value
conAsObject' opts@(A.Options {A.sumEncoding = A.TaggedObject tFld cFld}) sc = conAsTag   opts (pack tFld) (pack cFld) sc
conAsObject' opts@(A.Options {A.sumEncoding = A.TwoElemArray          }) sc = conAsArray opts sc
conAsObject' opts@(A.Options {A.sumEncoding = A.ObjectWithSingleField }) sc = conAsMap   opts sc
#if MIN_VERSION_aeson(1,0,0)
conAsObject' _opts@(A.Options {A.sumEncoding = A.UntaggedValue })       _sc = error "Unsupported option"
#endif

conAsTag :: A.Options -> Text -> Text ->  SchemaChoice -> A.Value
conAsTag opts tFld cFld (SCChoiceEnum  tag _)      = object [(tFld, object [("enum", array [tag])]), (cFld, conToArray opts [])]
conAsTag opts tFld cFld (SCChoiceArray tag _ ar)   = object [(tFld, object [("enum", array [tag])]), (cFld, conToArray opts ar)]
conAsTag opts tFld _    (SCChoiceMap   tag _ mp _) = object ((tFld, object [("enum", array [tag])]) : toMap opts mp)

conAsArray :: A.Options -> SchemaChoice -> A.Value
conAsArray opts (SCChoiceEnum  tag _)       = array [object [("enum", array [tag])], conToArray  opts []]
conAsArray opts (SCChoiceArray tag _ ar)    = array [object [("enum", array [tag])], conToArray  opts ar]
conAsArray opts (SCChoiceMap   tag _ mp rq) = array [object [("enum", array [tag])], conToObject opts mp rq]

conAsMap :: A.Options -> SchemaChoice -> A.Value
conAsMap opts (SCChoiceEnum  tag _)       = object [(tag, conToArray  opts [])]
conAsMap opts (SCChoiceArray tag _ ar)    = object [(tag, conToArray  opts ar)]
conAsMap opts (SCChoiceMap   tag _ mp rq) = object [(tag, conToObject opts mp rq)]

conToArray :: A.Options -> [Schema] -> A.Value
conToArray opts ar = object
    [ ("type", "array")
    , ("items", array . map (convert' True opts) $ ar)
    , ("minItems", A.toJSON $ length ar)
    , ("maxItems", A.toJSON $ length ar)
    , ("additionalItems", false)
    ]

conToObject :: A.Options -> [(Text,Schema)] -> [Text] -> A.Value
conToObject opts mp rq = object
    [ ("type", "object")
    , ("properties", object $ toMap opts mp)
    , ("required", required opts)
    , ("additionalProperties", false)
    ]
  where
    required A.Options {A.omitNothingFields = True} = array rq
    required A.Options {A.omitNothingFields = _   } = array . map fst $ toMap opts mp

toMap :: A.Options -> [(Text,Schema)] -> [(Text,A.Value)]
toMap opts mp = map (\(n,v) -> (n,convert' False opts v)) mp