module Debugger.API
  ( API
  , ServerAPI

  , LayerName
  , Drawing(Drawing)
  , Drawings

  , defaultHost
  , defaultPort
  ) where

import           Servant.API
import           GHC.Generics
import           Data.Aeson
import           Data.Text (Text)
import           Miso.Types
import           Miso.Aeson
import qualified Data.Aeson as Aeson
import qualified Miso.JSON as Miso
import           Data.Coerce
import           Data.Map (Map)
import           Data.Sequence (Seq)

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


type LayerName = String

newtype Drawing = Drawing MisoString
  deriving ((forall x. Drawing -> Rep Drawing x)
-> (forall x. Rep Drawing x -> Drawing) -> Generic Drawing
forall x. Rep Drawing x -> Drawing
forall x. Drawing -> Rep Drawing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Drawing -> Rep Drawing x
from :: forall x. Drawing -> Rep Drawing x
$cto :: forall x. Rep Drawing x -> Drawing
to :: forall x. Rep Drawing x -> Drawing
Generic, Drawing -> Drawing -> Bool
(Drawing -> Drawing -> Bool)
-> (Drawing -> Drawing -> Bool) -> Eq Drawing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Drawing -> Drawing -> Bool
== :: Drawing -> Drawing -> Bool
$c/= :: Drawing -> Drawing -> Bool
/= :: Drawing -> Drawing -> Bool
Eq, Int -> Drawing -> ShowS
[Drawing] -> ShowS
Drawing -> String
(Int -> Drawing -> ShowS)
-> (Drawing -> String) -> ([Drawing] -> ShowS) -> Show Drawing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Drawing -> ShowS
showsPrec :: Int -> Drawing -> ShowS
$cshow :: Drawing -> String
show :: Drawing -> String
$cshowList :: [Drawing] -> ShowS
showList :: [Drawing] -> ShowS
Show)
  deriving newtype (Value -> Parser Drawing
(Value -> Parser Drawing) -> FromJSON Drawing
forall a. (Value -> Parser a) -> FromJSON a
$cparseJSON :: Value -> Parser Drawing
parseJSON :: Value -> Parser Drawing
Miso.FromJSON, Drawing -> Value
(Drawing -> Value) -> ToJSON Drawing
forall a. (a -> Value) -> ToJSON a
$ctoJSON :: Drawing -> Value
toJSON :: Drawing -> Value
Miso.ToJSON)
  deriving ([Drawing] -> Value
[Drawing] -> Encoding
Drawing -> Bool
Drawing -> Value
Drawing -> Encoding
(Drawing -> Value)
-> (Drawing -> Encoding)
-> ([Drawing] -> Value)
-> ([Drawing] -> Encoding)
-> (Drawing -> Bool)
-> ToJSON Drawing
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Drawing -> Value
toJSON :: Drawing -> Value
$ctoEncoding :: Drawing -> Encoding
toEncoding :: Drawing -> Encoding
$ctoJSONList :: [Drawing] -> Value
toJSONList :: [Drawing] -> Value
$ctoEncodingList :: [Drawing] -> Encoding
toEncodingList :: [Drawing] -> Encoding
$comitField :: Drawing -> Bool
omitField :: Drawing -> Bool
Aeson.ToJSON, Maybe Drawing
Value -> Parser [Drawing]
Value -> Parser Drawing
(Value -> Parser Drawing)
-> (Value -> Parser [Drawing]) -> Maybe Drawing -> FromJSON Drawing
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Drawing
parseJSON :: Value -> Parser Drawing
$cparseJSONList :: Value -> Parser [Drawing]
parseJSONList :: Value -> Parser [Drawing]
$comittedField :: Maybe Drawing
omittedField :: Maybe Drawing
Aeson.FromJSON) via MisoAeson Drawing

instance (Aeson.ToJSONKey k, Aeson.ToJSON k, Aeson.ToJSON v) => Miso.ToJSON (Map k v) where
  toJSON :: Map k v -> Value
toJSON = MisoAeson (Map k v) -> Value
forall a. ToJSON a => a -> Value
Miso.toJSON (MisoAeson (Map k v) -> Value)
-> (Map k v -> MisoAeson (Map k v)) -> Map k v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> MisoAeson (Map k v)
forall a. a -> MisoAeson a
MisoAeson

instance (Aeson.FromJSONKey k, Ord k, Aeson.FromJSON v
         ) => Miso.FromJSON (Map k v) where
  parseJSON :: Value -> Parser (Map k v)
parseJSON = (MisoAeson (Map k v) -> Map k v)
-> Parser (MisoAeson (Map k v)) -> Parser (Map k v)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MisoAeson Map k v
x) -> Map k v
x) (Parser (MisoAeson (Map k v)) -> Parser (Map k v))
-> (Value -> Parser (MisoAeson (Map k v)))
-> Value
-> Parser (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (MisoAeson (Map k v))
forall a. FromJSON a => Value -> Parser a
Miso.parseJSON

instance Miso.ToJSON a => Aeson.ToJSON (MisoAeson a) where
  toJSON :: MisoAeson a -> Value
toJSON (MisoAeson a
x) = Value -> Value
jsonToAeson (Value -> Value) -> (a -> Value) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
Miso.toJSON (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ a
x

instance Miso.FromJSON a => Aeson.FromJSON (MisoAeson a) where
  parseJSON :: Value -> Parser (MisoAeson a)
parseJSON Value
s = case Parser a -> Either MisoString a
forall a. Parser a -> Either MisoString a
Miso.unParser (Parser a -> Either MisoString a)
-> (Value -> Parser a) -> Value -> Either MisoString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Miso.parseJSON (Value -> Parser a) -> (Value -> Value) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
aesonToJSON (Value -> Either MisoString a) -> Value -> Either MisoString a
forall a b. (a -> b) -> a -> b
$ Value
s of
                  Left MisoString
err -> String -> Parser (MisoAeson a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (MisoString -> String
forall a. Show a => a -> String
show MisoString
err)
                  Right a
x  -> MisoAeson a -> Parser (MisoAeson a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> MisoAeson a
forall a. a -> MisoAeson a
MisoAeson a
x)


type Drawings = Map LayerName (Seq (String, Drawing))

type API =    "drawing"    :> Get '[ JSON ] Drawings
         :<|> "drawLayer"  :> ReqBody '[ JSON ] (LayerName, String, Drawing) :> Put '[JSON] ()
         :<|> "clearLayer" :> ReqBody '[ PlainText ] LayerName               :> Put '[JSON] ()
         :<|> "clear"      :> Put '[JSON] ()

type ServerAPI = "pub"        :> Raw
         :<|> API

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

defaultPort :: Int -- Port
defaultPort :: Int
defaultPort = Int
8000

defaultHost :: String
defaultHost :: String
defaultHost = String
"localhost"




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

-- deriving instance (Generic action, Generic model) => Generic (View model action)
-- deriving instance (Generic parent, Generic model, Generic action
--                   ) => Generic (Component parent model action)
-- instance (Generic parent) => Generic (SomeComponent parent) where



-- data ViewJSON =

-- instance (ToJSON model, ToJSON action) => ToJSON (View model action) where
--    toEncoding =


--      genericToEncoding defaultOptions