{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

module Schema
  ( Schema,
    viewSchema,
    schemaTable,
    schemaForm,
  )
where

import Control.Applicative ((<|>))
import Data.Aeson qualified as A
import Data.Aeson.Key qualified as AK
import Data.Aeson.KeyMap qualified as AM
import Data.List
import Data.Map qualified as M
import Data.Maybe
import Data.Set qualified as S
import Form qualified as F
import Miso
import Miso.String (MisoString, fromMisoString, toMisoString)
import Route

data Schema = Schema
  { id :: MisoString,
    schema :: MisoString,
    properties :: M.Map MisoString Property,
    required :: S.Set MisoString,
    title :: MisoString,
    type_ :: MisoString
  }
  deriving (Show, Eq)

instance A.FromJSON Schema where
  parseJSON = A.withObject "Schema" $ \v ->
    Schema
      <$> v A..: "$id"
      <*> v A..: "$schema"
      <*> v A..: "properties"
      <*> v A..: "required"
      <*> v A..: "title"
      <*> v A..: "type"

data Property
  = Type MisoString
  | Reference MisoString
  deriving (Show, Eq)

instance A.FromJSON Property where
  parseJSON = A.withObject "Property" $ \v ->
    (Type <$> v A..: "type")
      <|> (Reference <$> v A..: "$ref")

viewSchema :: Schema -> View action
viewSchema schema =
  ol_ [] $
    ( \(k, v) ->
        li_ [] $
          [ text (toMisoString k),
            text ":",
            text
              ( case v of
                  Type v -> toMisoString v
                  Reference v -> "reference to " <> toMisoString v
              ),
            text (if k `S.member` schema.required then "" else "?")
          ]
    )
      <$> (M.toList schema.properties)

schemaTable :: MisoString -> Schema -> [A.Object] -> View action
schemaTable collection schema values =
  table_ [] [thead, tbody]
  where
    thead =
      thead_ [] $
        [ tr_ [] $
            [ th_ [] [text (toMisoString k)]
              | k <- M.keys schema.properties
            ]
        ]
    tbody =
      tbody_ [] $
        [ tr_
            []
            [ td_ [] $
                [ case (k, getO (AK.fromText (fromMisoString k)) value) of
                    ("$fileName", A.String fn) ->
                      a_
                        [ href_
                            (routeToMisoString (EditValue collection (toMisoString fn)))
                        ]
                        [ text (toMisoString fn)
                        ]
                    (_, v) ->
                      text $
                        case v of
                          A.String s -> toMisoString s
                          _ -> toMisoString (A.encode v)
                ]
              | k <- M.keys schema.properties
            ]
          | value <- values
        ]

schemaForm :: Schema -> F.Form A.Object A.Object
schemaForm schema =
  fmap mergeJson . sequence $
    ( \((AK.fromText . fromMisoString) -> k, v) ->
        case v of
          Type "string" ->
            if toMisoString (AK.toText k) `S.member` schema.required
              then
                AM.singleton k
                  <$> ( F.mapValues (getO k) (setO k) $
                          fmap (A.String . fromMisoString) . F.mapValues fromJson toJson $
                            F.input (toMisoString (AK.toString k))
                      )
              else
                AM.singleton k
                  <$> ( F.mapValues (getO k) (setO k)
                          $ fmap (maybe A.Null (A.String . fromMisoString))
                            . F.mapValues fromJson toJson
                          $ F.optional (F.input (toMisoString (AK.toString k)))
                      )
    )
      <$> (M.toList schema.properties)

mergeJson :: [A.Object] -> A.Object
mergeJson = foldl' mergeObject AM.empty

mergeObject :: A.Object -> A.Object -> A.Object
mergeObject kvs kvs' = AM.union kvs kvs'

fromJson :: A.Value -> MisoString
fromJson (A.String x) = toMisoString x
fromJson _ = ""

toJson :: MisoString -> A.Value -> A.Value
toJson x _ = A.String (fromMisoString x)

getO :: AK.Key -> A.Object -> A.Value
getO k kvs = fromMaybe A.Null (AM.lookup k kvs)

setO :: AK.Key -> A.Value -> A.Object -> A.Object
setO k v kvs = AM.insert k v kvs