module Mensam.API.Data.Desk where

import Mensam.API.Aeson
import Mensam.API.Data.Space
import Mensam.API.Pretty

import Data.Aeson qualified as A
import Data.Int
import Data.Kind
import Data.Proxy
import Data.Text qualified as T
import Deriving.Aeson qualified as A
import GHC.Generics
import GHC.TypeLits

type Desk :: Type
data Desk = MkDesk
  { Desk -> IdentifierDesk
deskId :: IdentifierDesk
  , Desk -> IdentifierSpace
deskSpace :: IdentifierSpace
  , Desk -> NameDesk
deskName :: NameDesk
  , Desk -> Maybe LocationDesk
deskLocation :: Maybe LocationDesk
  }
  deriving stock (Desk -> Desk -> Bool
(Desk -> Desk -> Bool) -> (Desk -> Desk -> Bool) -> Eq Desk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Desk -> Desk -> Bool
== :: Desk -> Desk -> Bool
$c/= :: Desk -> Desk -> Bool
/= :: Desk -> Desk -> Bool
Eq, (forall x. Desk -> Rep Desk x)
-> (forall x. Rep Desk x -> Desk) -> Generic Desk
forall x. Rep Desk x -> Desk
forall x. Desk -> Rep Desk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Desk -> Rep Desk x
from :: forall x. Desk -> Rep Desk x
$cto :: forall x. Rep Desk x -> Desk
to :: forall x. Rep Desk x -> Desk
Generic, Eq Desk
Eq Desk =>
(Desk -> Desk -> Ordering)
-> (Desk -> Desk -> Bool)
-> (Desk -> Desk -> Bool)
-> (Desk -> Desk -> Bool)
-> (Desk -> Desk -> Bool)
-> (Desk -> Desk -> Desk)
-> (Desk -> Desk -> Desk)
-> Ord Desk
Desk -> Desk -> Bool
Desk -> Desk -> Ordering
Desk -> Desk -> Desk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Desk -> Desk -> Ordering
compare :: Desk -> Desk -> Ordering
$c< :: Desk -> Desk -> Bool
< :: Desk -> Desk -> Bool
$c<= :: Desk -> Desk -> Bool
<= :: Desk -> Desk -> Bool
$c> :: Desk -> Desk -> Bool
> :: Desk -> Desk -> Bool
$c>= :: Desk -> Desk -> Bool
>= :: Desk -> Desk -> Bool
$cmax :: Desk -> Desk -> Desk
max :: Desk -> Desk -> Desk
$cmin :: Desk -> Desk -> Desk
min :: Desk -> Desk -> Desk
Ord, ReadPrec [Desk]
ReadPrec Desk
Int -> ReadS Desk
ReadS [Desk]
(Int -> ReadS Desk)
-> ReadS [Desk] -> ReadPrec Desk -> ReadPrec [Desk] -> Read Desk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Desk
readsPrec :: Int -> ReadS Desk
$creadList :: ReadS [Desk]
readList :: ReadS [Desk]
$creadPrec :: ReadPrec Desk
readPrec :: ReadPrec Desk
$creadListPrec :: ReadPrec [Desk]
readListPrec :: ReadPrec [Desk]
Read, Int -> Desk -> ShowS
[Desk] -> ShowS
Desk -> String
(Int -> Desk -> ShowS)
-> (Desk -> String) -> ([Desk] -> ShowS) -> Show Desk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Desk -> ShowS
showsPrec :: Int -> Desk -> ShowS
$cshow :: Desk -> String
show :: Desk -> String
$cshowList :: [Desk] -> ShowS
showList :: [Desk] -> ShowS
Show)
  deriving
    (Value -> Parser [Desk]
Value -> Parser Desk
(Value -> Parser Desk) -> (Value -> Parser [Desk]) -> FromJSON Desk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Desk
parseJSON :: Value -> Parser Desk
$cparseJSONList :: Value -> Parser [Desk]
parseJSONList :: Value -> Parser [Desk]
A.FromJSON, [Desk] -> Value
[Desk] -> Encoding
Desk -> Value
Desk -> Encoding
(Desk -> Value)
-> (Desk -> Encoding)
-> ([Desk] -> Value)
-> ([Desk] -> Encoding)
-> ToJSON Desk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Desk -> Value
toJSON :: Desk -> Value
$ctoEncoding :: Desk -> Encoding
toEncoding :: Desk -> Encoding
$ctoJSONList :: [Desk] -> Value
toJSONList :: [Desk] -> Value
$ctoEncodingList :: [Desk] -> Encoding
toEncodingList :: [Desk] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "desk") Desk

type IdentifierDesk :: Type
newtype IdentifierDesk = MkIdentifierDesk {IdentifierDesk -> Int64
unIdentifierDesk :: Int64}
  deriving stock (IdentifierDesk -> IdentifierDesk -> Bool
(IdentifierDesk -> IdentifierDesk -> Bool)
-> (IdentifierDesk -> IdentifierDesk -> Bool) -> Eq IdentifierDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierDesk -> IdentifierDesk -> Bool
== :: IdentifierDesk -> IdentifierDesk -> Bool
$c/= :: IdentifierDesk -> IdentifierDesk -> Bool
/= :: IdentifierDesk -> IdentifierDesk -> Bool
Eq, (forall x. IdentifierDesk -> Rep IdentifierDesk x)
-> (forall x. Rep IdentifierDesk x -> IdentifierDesk)
-> Generic IdentifierDesk
forall x. Rep IdentifierDesk x -> IdentifierDesk
forall x. IdentifierDesk -> Rep IdentifierDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IdentifierDesk -> Rep IdentifierDesk x
from :: forall x. IdentifierDesk -> Rep IdentifierDesk x
$cto :: forall x. Rep IdentifierDesk x -> IdentifierDesk
to :: forall x. Rep IdentifierDesk x -> IdentifierDesk
Generic, Eq IdentifierDesk
Eq IdentifierDesk =>
(IdentifierDesk -> IdentifierDesk -> Ordering)
-> (IdentifierDesk -> IdentifierDesk -> Bool)
-> (IdentifierDesk -> IdentifierDesk -> Bool)
-> (IdentifierDesk -> IdentifierDesk -> Bool)
-> (IdentifierDesk -> IdentifierDesk -> Bool)
-> (IdentifierDesk -> IdentifierDesk -> IdentifierDesk)
-> (IdentifierDesk -> IdentifierDesk -> IdentifierDesk)
-> Ord IdentifierDesk
IdentifierDesk -> IdentifierDesk -> Bool
IdentifierDesk -> IdentifierDesk -> Ordering
IdentifierDesk -> IdentifierDesk -> IdentifierDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdentifierDesk -> IdentifierDesk -> Ordering
compare :: IdentifierDesk -> IdentifierDesk -> Ordering
$c< :: IdentifierDesk -> IdentifierDesk -> Bool
< :: IdentifierDesk -> IdentifierDesk -> Bool
$c<= :: IdentifierDesk -> IdentifierDesk -> Bool
<= :: IdentifierDesk -> IdentifierDesk -> Bool
$c> :: IdentifierDesk -> IdentifierDesk -> Bool
> :: IdentifierDesk -> IdentifierDesk -> Bool
$c>= :: IdentifierDesk -> IdentifierDesk -> Bool
>= :: IdentifierDesk -> IdentifierDesk -> Bool
$cmax :: IdentifierDesk -> IdentifierDesk -> IdentifierDesk
max :: IdentifierDesk -> IdentifierDesk -> IdentifierDesk
$cmin :: IdentifierDesk -> IdentifierDesk -> IdentifierDesk
min :: IdentifierDesk -> IdentifierDesk -> IdentifierDesk
Ord, ReadPrec [IdentifierDesk]
ReadPrec IdentifierDesk
Int -> ReadS IdentifierDesk
ReadS [IdentifierDesk]
(Int -> ReadS IdentifierDesk)
-> ReadS [IdentifierDesk]
-> ReadPrec IdentifierDesk
-> ReadPrec [IdentifierDesk]
-> Read IdentifierDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS IdentifierDesk
readsPrec :: Int -> ReadS IdentifierDesk
$creadList :: ReadS [IdentifierDesk]
readList :: ReadS [IdentifierDesk]
$creadPrec :: ReadPrec IdentifierDesk
readPrec :: ReadPrec IdentifierDesk
$creadListPrec :: ReadPrec [IdentifierDesk]
readListPrec :: ReadPrec [IdentifierDesk]
Read, Int -> IdentifierDesk -> ShowS
[IdentifierDesk] -> ShowS
IdentifierDesk -> String
(Int -> IdentifierDesk -> ShowS)
-> (IdentifierDesk -> String)
-> ([IdentifierDesk] -> ShowS)
-> Show IdentifierDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentifierDesk -> ShowS
showsPrec :: Int -> IdentifierDesk -> ShowS
$cshow :: IdentifierDesk -> String
show :: IdentifierDesk -> String
$cshowList :: [IdentifierDesk] -> ShowS
showList :: [IdentifierDesk] -> ShowS
Show)
  deriving newtype (Value -> Parser [IdentifierDesk]
Value -> Parser IdentifierDesk
(Value -> Parser IdentifierDesk)
-> (Value -> Parser [IdentifierDesk]) -> FromJSON IdentifierDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser IdentifierDesk
parseJSON :: Value -> Parser IdentifierDesk
$cparseJSONList :: Value -> Parser [IdentifierDesk]
parseJSONList :: Value -> Parser [IdentifierDesk]
A.FromJSON, [IdentifierDesk] -> Value
[IdentifierDesk] -> Encoding
IdentifierDesk -> Value
IdentifierDesk -> Encoding
(IdentifierDesk -> Value)
-> (IdentifierDesk -> Encoding)
-> ([IdentifierDesk] -> Value)
-> ([IdentifierDesk] -> Encoding)
-> ToJSON IdentifierDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: IdentifierDesk -> Value
toJSON :: IdentifierDesk -> Value
$ctoEncoding :: IdentifierDesk -> Encoding
toEncoding :: IdentifierDesk -> Encoding
$ctoJSONList :: [IdentifierDesk] -> Value
toJSONList :: [IdentifierDesk] -> Value
$ctoEncodingList :: [IdentifierDesk] -> Encoding
toEncodingList :: [IdentifierDesk] -> Encoding
A.ToJSON)

instance ToPrettyText IdentifierDesk where
  toPrettyText :: IdentifierDesk -> Text
toPrettyText = (Text
"#" <>) (Text -> Text)
-> (IdentifierDesk -> Text) -> IdentifierDesk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (IdentifierDesk -> String) -> IdentifierDesk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String)
-> (IdentifierDesk -> Int64) -> IdentifierDesk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDesk -> Int64
unIdentifierDesk

deriving via PrettyHtml5ViaPrettyText IdentifierDesk instance ToPrettyHtml5 IdentifierDesk

type NameDesk :: Type
newtype NameDesk = MkNameDesk {NameDesk -> Text
unNameDesk :: T.Text}
  deriving stock (NameDesk -> NameDesk -> Bool
(NameDesk -> NameDesk -> Bool)
-> (NameDesk -> NameDesk -> Bool) -> Eq NameDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameDesk -> NameDesk -> Bool
== :: NameDesk -> NameDesk -> Bool
$c/= :: NameDesk -> NameDesk -> Bool
/= :: NameDesk -> NameDesk -> Bool
Eq, (forall x. NameDesk -> Rep NameDesk x)
-> (forall x. Rep NameDesk x -> NameDesk) -> Generic NameDesk
forall x. Rep NameDesk x -> NameDesk
forall x. NameDesk -> Rep NameDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameDesk -> Rep NameDesk x
from :: forall x. NameDesk -> Rep NameDesk x
$cto :: forall x. Rep NameDesk x -> NameDesk
to :: forall x. Rep NameDesk x -> NameDesk
Generic, Eq NameDesk
Eq NameDesk =>
(NameDesk -> NameDesk -> Ordering)
-> (NameDesk -> NameDesk -> Bool)
-> (NameDesk -> NameDesk -> Bool)
-> (NameDesk -> NameDesk -> Bool)
-> (NameDesk -> NameDesk -> Bool)
-> (NameDesk -> NameDesk -> NameDesk)
-> (NameDesk -> NameDesk -> NameDesk)
-> Ord NameDesk
NameDesk -> NameDesk -> Bool
NameDesk -> NameDesk -> Ordering
NameDesk -> NameDesk -> NameDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameDesk -> NameDesk -> Ordering
compare :: NameDesk -> NameDesk -> Ordering
$c< :: NameDesk -> NameDesk -> Bool
< :: NameDesk -> NameDesk -> Bool
$c<= :: NameDesk -> NameDesk -> Bool
<= :: NameDesk -> NameDesk -> Bool
$c> :: NameDesk -> NameDesk -> Bool
> :: NameDesk -> NameDesk -> Bool
$c>= :: NameDesk -> NameDesk -> Bool
>= :: NameDesk -> NameDesk -> Bool
$cmax :: NameDesk -> NameDesk -> NameDesk
max :: NameDesk -> NameDesk -> NameDesk
$cmin :: NameDesk -> NameDesk -> NameDesk
min :: NameDesk -> NameDesk -> NameDesk
Ord, ReadPrec [NameDesk]
ReadPrec NameDesk
Int -> ReadS NameDesk
ReadS [NameDesk]
(Int -> ReadS NameDesk)
-> ReadS [NameDesk]
-> ReadPrec NameDesk
-> ReadPrec [NameDesk]
-> Read NameDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NameDesk
readsPrec :: Int -> ReadS NameDesk
$creadList :: ReadS [NameDesk]
readList :: ReadS [NameDesk]
$creadPrec :: ReadPrec NameDesk
readPrec :: ReadPrec NameDesk
$creadListPrec :: ReadPrec [NameDesk]
readListPrec :: ReadPrec [NameDesk]
Read, Int -> NameDesk -> ShowS
[NameDesk] -> ShowS
NameDesk -> String
(Int -> NameDesk -> ShowS)
-> (NameDesk -> String) -> ([NameDesk] -> ShowS) -> Show NameDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameDesk -> ShowS
showsPrec :: Int -> NameDesk -> ShowS
$cshow :: NameDesk -> String
show :: NameDesk -> String
$cshowList :: [NameDesk] -> ShowS
showList :: [NameDesk] -> ShowS
Show)
  deriving newtype (Value -> Parser [NameDesk]
Value -> Parser NameDesk
(Value -> Parser NameDesk)
-> (Value -> Parser [NameDesk]) -> FromJSON NameDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NameDesk
parseJSON :: Value -> Parser NameDesk
$cparseJSONList :: Value -> Parser [NameDesk]
parseJSONList :: Value -> Parser [NameDesk]
A.FromJSON, [NameDesk] -> Value
[NameDesk] -> Encoding
NameDesk -> Value
NameDesk -> Encoding
(NameDesk -> Value)
-> (NameDesk -> Encoding)
-> ([NameDesk] -> Value)
-> ([NameDesk] -> Encoding)
-> ToJSON NameDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NameDesk -> Value
toJSON :: NameDesk -> Value
$ctoEncoding :: NameDesk -> Encoding
toEncoding :: NameDesk -> Encoding
$ctoJSONList :: [NameDesk] -> Value
toJSONList :: [NameDesk] -> Value
$ctoEncodingList :: [NameDesk] -> Encoding
toEncodingList :: [NameDesk] -> Encoding
A.ToJSON)

deriving via PrettyTextViaShow T.Text instance ToPrettyText NameDesk
deriving via PrettyHtml5ViaPrettyText NameDesk instance ToPrettyHtml5 NameDesk

type DeskNameWithContext :: Type
data DeskNameWithContext = MkDeskNameWithContext
  { DeskNameWithContext -> NameDesk
deskNameWithContextDesk :: NameDesk
  , DeskNameWithContext -> NameSpace
deskNameWithContextSpace :: NameSpace
  }
  deriving stock (DeskNameWithContext -> DeskNameWithContext -> Bool
(DeskNameWithContext -> DeskNameWithContext -> Bool)
-> (DeskNameWithContext -> DeskNameWithContext -> Bool)
-> Eq DeskNameWithContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeskNameWithContext -> DeskNameWithContext -> Bool
== :: DeskNameWithContext -> DeskNameWithContext -> Bool
$c/= :: DeskNameWithContext -> DeskNameWithContext -> Bool
/= :: DeskNameWithContext -> DeskNameWithContext -> Bool
Eq, (forall x. DeskNameWithContext -> Rep DeskNameWithContext x)
-> (forall x. Rep DeskNameWithContext x -> DeskNameWithContext)
-> Generic DeskNameWithContext
forall x. Rep DeskNameWithContext x -> DeskNameWithContext
forall x. DeskNameWithContext -> Rep DeskNameWithContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeskNameWithContext -> Rep DeskNameWithContext x
from :: forall x. DeskNameWithContext -> Rep DeskNameWithContext x
$cto :: forall x. Rep DeskNameWithContext x -> DeskNameWithContext
to :: forall x. Rep DeskNameWithContext x -> DeskNameWithContext
Generic, Eq DeskNameWithContext
Eq DeskNameWithContext =>
(DeskNameWithContext -> DeskNameWithContext -> Ordering)
-> (DeskNameWithContext -> DeskNameWithContext -> Bool)
-> (DeskNameWithContext -> DeskNameWithContext -> Bool)
-> (DeskNameWithContext -> DeskNameWithContext -> Bool)
-> (DeskNameWithContext -> DeskNameWithContext -> Bool)
-> (DeskNameWithContext
    -> DeskNameWithContext -> DeskNameWithContext)
-> (DeskNameWithContext
    -> DeskNameWithContext -> DeskNameWithContext)
-> Ord DeskNameWithContext
DeskNameWithContext -> DeskNameWithContext -> Bool
DeskNameWithContext -> DeskNameWithContext -> Ordering
DeskNameWithContext -> DeskNameWithContext -> DeskNameWithContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeskNameWithContext -> DeskNameWithContext -> Ordering
compare :: DeskNameWithContext -> DeskNameWithContext -> Ordering
$c< :: DeskNameWithContext -> DeskNameWithContext -> Bool
< :: DeskNameWithContext -> DeskNameWithContext -> Bool
$c<= :: DeskNameWithContext -> DeskNameWithContext -> Bool
<= :: DeskNameWithContext -> DeskNameWithContext -> Bool
$c> :: DeskNameWithContext -> DeskNameWithContext -> Bool
> :: DeskNameWithContext -> DeskNameWithContext -> Bool
$c>= :: DeskNameWithContext -> DeskNameWithContext -> Bool
>= :: DeskNameWithContext -> DeskNameWithContext -> Bool
$cmax :: DeskNameWithContext -> DeskNameWithContext -> DeskNameWithContext
max :: DeskNameWithContext -> DeskNameWithContext -> DeskNameWithContext
$cmin :: DeskNameWithContext -> DeskNameWithContext -> DeskNameWithContext
min :: DeskNameWithContext -> DeskNameWithContext -> DeskNameWithContext
Ord, ReadPrec [DeskNameWithContext]
ReadPrec DeskNameWithContext
Int -> ReadS DeskNameWithContext
ReadS [DeskNameWithContext]
(Int -> ReadS DeskNameWithContext)
-> ReadS [DeskNameWithContext]
-> ReadPrec DeskNameWithContext
-> ReadPrec [DeskNameWithContext]
-> Read DeskNameWithContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DeskNameWithContext
readsPrec :: Int -> ReadS DeskNameWithContext
$creadList :: ReadS [DeskNameWithContext]
readList :: ReadS [DeskNameWithContext]
$creadPrec :: ReadPrec DeskNameWithContext
readPrec :: ReadPrec DeskNameWithContext
$creadListPrec :: ReadPrec [DeskNameWithContext]
readListPrec :: ReadPrec [DeskNameWithContext]
Read, Int -> DeskNameWithContext -> ShowS
[DeskNameWithContext] -> ShowS
DeskNameWithContext -> String
(Int -> DeskNameWithContext -> ShowS)
-> (DeskNameWithContext -> String)
-> ([DeskNameWithContext] -> ShowS)
-> Show DeskNameWithContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeskNameWithContext -> ShowS
showsPrec :: Int -> DeskNameWithContext -> ShowS
$cshow :: DeskNameWithContext -> String
show :: DeskNameWithContext -> String
$cshowList :: [DeskNameWithContext] -> ShowS
showList :: [DeskNameWithContext] -> ShowS
Show)
  deriving
    (Value -> Parser [DeskNameWithContext]
Value -> Parser DeskNameWithContext
(Value -> Parser DeskNameWithContext)
-> (Value -> Parser [DeskNameWithContext])
-> FromJSON DeskNameWithContext
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DeskNameWithContext
parseJSON :: Value -> Parser DeskNameWithContext
$cparseJSONList :: Value -> Parser [DeskNameWithContext]
parseJSONList :: Value -> Parser [DeskNameWithContext]
A.FromJSON, [DeskNameWithContext] -> Value
[DeskNameWithContext] -> Encoding
DeskNameWithContext -> Value
DeskNameWithContext -> Encoding
(DeskNameWithContext -> Value)
-> (DeskNameWithContext -> Encoding)
-> ([DeskNameWithContext] -> Value)
-> ([DeskNameWithContext] -> Encoding)
-> ToJSON DeskNameWithContext
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DeskNameWithContext -> Value
toJSON :: DeskNameWithContext -> Value
$ctoEncoding :: DeskNameWithContext -> Encoding
toEncoding :: DeskNameWithContext -> Encoding
$ctoJSONList :: [DeskNameWithContext] -> Value
toJSONList :: [DeskNameWithContext] -> Value
$ctoEncodingList :: [DeskNameWithContext] -> Encoding
toEncodingList :: [DeskNameWithContext] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "deskNameWithContext") DeskNameWithContext

type LocationDesk :: Type
data LocationDesk = MkLocationDesk
  { LocationDesk -> PositionDesk
locationDeskPosition :: PositionDesk
  , LocationDesk -> DirectionDesk
locationDeskDirection :: DirectionDesk
  , LocationDesk -> SizeDesk
locationDeskSize :: SizeDesk
  }
  deriving stock (LocationDesk -> LocationDesk -> Bool
(LocationDesk -> LocationDesk -> Bool)
-> (LocationDesk -> LocationDesk -> Bool) -> Eq LocationDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocationDesk -> LocationDesk -> Bool
== :: LocationDesk -> LocationDesk -> Bool
$c/= :: LocationDesk -> LocationDesk -> Bool
/= :: LocationDesk -> LocationDesk -> Bool
Eq, (forall x. LocationDesk -> Rep LocationDesk x)
-> (forall x. Rep LocationDesk x -> LocationDesk)
-> Generic LocationDesk
forall x. Rep LocationDesk x -> LocationDesk
forall x. LocationDesk -> Rep LocationDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocationDesk -> Rep LocationDesk x
from :: forall x. LocationDesk -> Rep LocationDesk x
$cto :: forall x. Rep LocationDesk x -> LocationDesk
to :: forall x. Rep LocationDesk x -> LocationDesk
Generic, Eq LocationDesk
Eq LocationDesk =>
(LocationDesk -> LocationDesk -> Ordering)
-> (LocationDesk -> LocationDesk -> Bool)
-> (LocationDesk -> LocationDesk -> Bool)
-> (LocationDesk -> LocationDesk -> Bool)
-> (LocationDesk -> LocationDesk -> Bool)
-> (LocationDesk -> LocationDesk -> LocationDesk)
-> (LocationDesk -> LocationDesk -> LocationDesk)
-> Ord LocationDesk
LocationDesk -> LocationDesk -> Bool
LocationDesk -> LocationDesk -> Ordering
LocationDesk -> LocationDesk -> LocationDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LocationDesk -> LocationDesk -> Ordering
compare :: LocationDesk -> LocationDesk -> Ordering
$c< :: LocationDesk -> LocationDesk -> Bool
< :: LocationDesk -> LocationDesk -> Bool
$c<= :: LocationDesk -> LocationDesk -> Bool
<= :: LocationDesk -> LocationDesk -> Bool
$c> :: LocationDesk -> LocationDesk -> Bool
> :: LocationDesk -> LocationDesk -> Bool
$c>= :: LocationDesk -> LocationDesk -> Bool
>= :: LocationDesk -> LocationDesk -> Bool
$cmax :: LocationDesk -> LocationDesk -> LocationDesk
max :: LocationDesk -> LocationDesk -> LocationDesk
$cmin :: LocationDesk -> LocationDesk -> LocationDesk
min :: LocationDesk -> LocationDesk -> LocationDesk
Ord, ReadPrec [LocationDesk]
ReadPrec LocationDesk
Int -> ReadS LocationDesk
ReadS [LocationDesk]
(Int -> ReadS LocationDesk)
-> ReadS [LocationDesk]
-> ReadPrec LocationDesk
-> ReadPrec [LocationDesk]
-> Read LocationDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LocationDesk
readsPrec :: Int -> ReadS LocationDesk
$creadList :: ReadS [LocationDesk]
readList :: ReadS [LocationDesk]
$creadPrec :: ReadPrec LocationDesk
readPrec :: ReadPrec LocationDesk
$creadListPrec :: ReadPrec [LocationDesk]
readListPrec :: ReadPrec [LocationDesk]
Read, Int -> LocationDesk -> ShowS
[LocationDesk] -> ShowS
LocationDesk -> String
(Int -> LocationDesk -> ShowS)
-> (LocationDesk -> String)
-> ([LocationDesk] -> ShowS)
-> Show LocationDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocationDesk -> ShowS
showsPrec :: Int -> LocationDesk -> ShowS
$cshow :: LocationDesk -> String
show :: LocationDesk -> String
$cshowList :: [LocationDesk] -> ShowS
showList :: [LocationDesk] -> ShowS
Show)
  deriving
    (Value -> Parser [LocationDesk]
Value -> Parser LocationDesk
(Value -> Parser LocationDesk)
-> (Value -> Parser [LocationDesk]) -> FromJSON LocationDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LocationDesk
parseJSON :: Value -> Parser LocationDesk
$cparseJSONList :: Value -> Parser [LocationDesk]
parseJSONList :: Value -> Parser [LocationDesk]
A.FromJSON, [LocationDesk] -> Value
[LocationDesk] -> Encoding
LocationDesk -> Value
LocationDesk -> Encoding
(LocationDesk -> Value)
-> (LocationDesk -> Encoding)
-> ([LocationDesk] -> Value)
-> ([LocationDesk] -> Encoding)
-> ToJSON LocationDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LocationDesk -> Value
toJSON :: LocationDesk -> Value
$ctoEncoding :: LocationDesk -> Encoding
toEncoding :: LocationDesk -> Encoding
$ctoJSONList :: [LocationDesk] -> Value
toJSONList :: [LocationDesk] -> Value
$ctoEncodingList :: [LocationDesk] -> Encoding
toEncodingList :: [LocationDesk] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "locationDesk") LocationDesk

type PositionDesk :: Type
data PositionDesk = MkPositionDesk
  { PositionDesk -> ConstrainedDouble '[]
positionDeskX :: ConstrainedDouble '[]
  , PositionDesk -> ConstrainedDouble '[]
positionDeskY :: ConstrainedDouble '[]
  }
  deriving stock (PositionDesk -> PositionDesk -> Bool
(PositionDesk -> PositionDesk -> Bool)
-> (PositionDesk -> PositionDesk -> Bool) -> Eq PositionDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PositionDesk -> PositionDesk -> Bool
== :: PositionDesk -> PositionDesk -> Bool
$c/= :: PositionDesk -> PositionDesk -> Bool
/= :: PositionDesk -> PositionDesk -> Bool
Eq, (forall x. PositionDesk -> Rep PositionDesk x)
-> (forall x. Rep PositionDesk x -> PositionDesk)
-> Generic PositionDesk
forall x. Rep PositionDesk x -> PositionDesk
forall x. PositionDesk -> Rep PositionDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PositionDesk -> Rep PositionDesk x
from :: forall x. PositionDesk -> Rep PositionDesk x
$cto :: forall x. Rep PositionDesk x -> PositionDesk
to :: forall x. Rep PositionDesk x -> PositionDesk
Generic, Eq PositionDesk
Eq PositionDesk =>
(PositionDesk -> PositionDesk -> Ordering)
-> (PositionDesk -> PositionDesk -> Bool)
-> (PositionDesk -> PositionDesk -> Bool)
-> (PositionDesk -> PositionDesk -> Bool)
-> (PositionDesk -> PositionDesk -> Bool)
-> (PositionDesk -> PositionDesk -> PositionDesk)
-> (PositionDesk -> PositionDesk -> PositionDesk)
-> Ord PositionDesk
PositionDesk -> PositionDesk -> Bool
PositionDesk -> PositionDesk -> Ordering
PositionDesk -> PositionDesk -> PositionDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PositionDesk -> PositionDesk -> Ordering
compare :: PositionDesk -> PositionDesk -> Ordering
$c< :: PositionDesk -> PositionDesk -> Bool
< :: PositionDesk -> PositionDesk -> Bool
$c<= :: PositionDesk -> PositionDesk -> Bool
<= :: PositionDesk -> PositionDesk -> Bool
$c> :: PositionDesk -> PositionDesk -> Bool
> :: PositionDesk -> PositionDesk -> Bool
$c>= :: PositionDesk -> PositionDesk -> Bool
>= :: PositionDesk -> PositionDesk -> Bool
$cmax :: PositionDesk -> PositionDesk -> PositionDesk
max :: PositionDesk -> PositionDesk -> PositionDesk
$cmin :: PositionDesk -> PositionDesk -> PositionDesk
min :: PositionDesk -> PositionDesk -> PositionDesk
Ord, ReadPrec [PositionDesk]
ReadPrec PositionDesk
Int -> ReadS PositionDesk
ReadS [PositionDesk]
(Int -> ReadS PositionDesk)
-> ReadS [PositionDesk]
-> ReadPrec PositionDesk
-> ReadPrec [PositionDesk]
-> Read PositionDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PositionDesk
readsPrec :: Int -> ReadS PositionDesk
$creadList :: ReadS [PositionDesk]
readList :: ReadS [PositionDesk]
$creadPrec :: ReadPrec PositionDesk
readPrec :: ReadPrec PositionDesk
$creadListPrec :: ReadPrec [PositionDesk]
readListPrec :: ReadPrec [PositionDesk]
Read, Int -> PositionDesk -> ShowS
[PositionDesk] -> ShowS
PositionDesk -> String
(Int -> PositionDesk -> ShowS)
-> (PositionDesk -> String)
-> ([PositionDesk] -> ShowS)
-> Show PositionDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PositionDesk -> ShowS
showsPrec :: Int -> PositionDesk -> ShowS
$cshow :: PositionDesk -> String
show :: PositionDesk -> String
$cshowList :: [PositionDesk] -> ShowS
showList :: [PositionDesk] -> ShowS
Show)
  deriving
    (Value -> Parser [PositionDesk]
Value -> Parser PositionDesk
(Value -> Parser PositionDesk)
-> (Value -> Parser [PositionDesk]) -> FromJSON PositionDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PositionDesk
parseJSON :: Value -> Parser PositionDesk
$cparseJSONList :: Value -> Parser [PositionDesk]
parseJSONList :: Value -> Parser [PositionDesk]
A.FromJSON, [PositionDesk] -> Value
[PositionDesk] -> Encoding
PositionDesk -> Value
PositionDesk -> Encoding
(PositionDesk -> Value)
-> (PositionDesk -> Encoding)
-> ([PositionDesk] -> Value)
-> ([PositionDesk] -> Encoding)
-> ToJSON PositionDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PositionDesk -> Value
toJSON :: PositionDesk -> Value
$ctoEncoding :: PositionDesk -> Encoding
toEncoding :: PositionDesk -> Encoding
$ctoJSONList :: [PositionDesk] -> Value
toJSONList :: [PositionDesk] -> Value
$ctoEncodingList :: [PositionDesk] -> Encoding
toEncodingList :: [PositionDesk] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "positionDesk") PositionDesk

type DirectionDesk :: Type
newtype DirectionDesk = MkDirectionDesk {DirectionDesk -> Direction
unDirectionDesk :: Direction}
  deriving stock (DirectionDesk -> DirectionDesk -> Bool
(DirectionDesk -> DirectionDesk -> Bool)
-> (DirectionDesk -> DirectionDesk -> Bool) -> Eq DirectionDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectionDesk -> DirectionDesk -> Bool
== :: DirectionDesk -> DirectionDesk -> Bool
$c/= :: DirectionDesk -> DirectionDesk -> Bool
/= :: DirectionDesk -> DirectionDesk -> Bool
Eq, (forall x. DirectionDesk -> Rep DirectionDesk x)
-> (forall x. Rep DirectionDesk x -> DirectionDesk)
-> Generic DirectionDesk
forall x. Rep DirectionDesk x -> DirectionDesk
forall x. DirectionDesk -> Rep DirectionDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectionDesk -> Rep DirectionDesk x
from :: forall x. DirectionDesk -> Rep DirectionDesk x
$cto :: forall x. Rep DirectionDesk x -> DirectionDesk
to :: forall x. Rep DirectionDesk x -> DirectionDesk
Generic, Eq DirectionDesk
Eq DirectionDesk =>
(DirectionDesk -> DirectionDesk -> Ordering)
-> (DirectionDesk -> DirectionDesk -> Bool)
-> (DirectionDesk -> DirectionDesk -> Bool)
-> (DirectionDesk -> DirectionDesk -> Bool)
-> (DirectionDesk -> DirectionDesk -> Bool)
-> (DirectionDesk -> DirectionDesk -> DirectionDesk)
-> (DirectionDesk -> DirectionDesk -> DirectionDesk)
-> Ord DirectionDesk
DirectionDesk -> DirectionDesk -> Bool
DirectionDesk -> DirectionDesk -> Ordering
DirectionDesk -> DirectionDesk -> DirectionDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DirectionDesk -> DirectionDesk -> Ordering
compare :: DirectionDesk -> DirectionDesk -> Ordering
$c< :: DirectionDesk -> DirectionDesk -> Bool
< :: DirectionDesk -> DirectionDesk -> Bool
$c<= :: DirectionDesk -> DirectionDesk -> Bool
<= :: DirectionDesk -> DirectionDesk -> Bool
$c> :: DirectionDesk -> DirectionDesk -> Bool
> :: DirectionDesk -> DirectionDesk -> Bool
$c>= :: DirectionDesk -> DirectionDesk -> Bool
>= :: DirectionDesk -> DirectionDesk -> Bool
$cmax :: DirectionDesk -> DirectionDesk -> DirectionDesk
max :: DirectionDesk -> DirectionDesk -> DirectionDesk
$cmin :: DirectionDesk -> DirectionDesk -> DirectionDesk
min :: DirectionDesk -> DirectionDesk -> DirectionDesk
Ord, ReadPrec [DirectionDesk]
ReadPrec DirectionDesk
Int -> ReadS DirectionDesk
ReadS [DirectionDesk]
(Int -> ReadS DirectionDesk)
-> ReadS [DirectionDesk]
-> ReadPrec DirectionDesk
-> ReadPrec [DirectionDesk]
-> Read DirectionDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DirectionDesk
readsPrec :: Int -> ReadS DirectionDesk
$creadList :: ReadS [DirectionDesk]
readList :: ReadS [DirectionDesk]
$creadPrec :: ReadPrec DirectionDesk
readPrec :: ReadPrec DirectionDesk
$creadListPrec :: ReadPrec [DirectionDesk]
readListPrec :: ReadPrec [DirectionDesk]
Read, Int -> DirectionDesk -> ShowS
[DirectionDesk] -> ShowS
DirectionDesk -> String
(Int -> DirectionDesk -> ShowS)
-> (DirectionDesk -> String)
-> ([DirectionDesk] -> ShowS)
-> Show DirectionDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectionDesk -> ShowS
showsPrec :: Int -> DirectionDesk -> ShowS
$cshow :: DirectionDesk -> String
show :: DirectionDesk -> String
$cshowList :: [DirectionDesk] -> ShowS
showList :: [DirectionDesk] -> ShowS
Show)
  deriving newtype (Value -> Parser [DirectionDesk]
Value -> Parser DirectionDesk
(Value -> Parser DirectionDesk)
-> (Value -> Parser [DirectionDesk]) -> FromJSON DirectionDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DirectionDesk
parseJSON :: Value -> Parser DirectionDesk
$cparseJSONList :: Value -> Parser [DirectionDesk]
parseJSONList :: Value -> Parser [DirectionDesk]
A.FromJSON, [DirectionDesk] -> Value
[DirectionDesk] -> Encoding
DirectionDesk -> Value
DirectionDesk -> Encoding
(DirectionDesk -> Value)
-> (DirectionDesk -> Encoding)
-> ([DirectionDesk] -> Value)
-> ([DirectionDesk] -> Encoding)
-> ToJSON DirectionDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DirectionDesk -> Value
toJSON :: DirectionDesk -> Value
$ctoEncoding :: DirectionDesk -> Encoding
toEncoding :: DirectionDesk -> Encoding
$ctoJSONList :: [DirectionDesk] -> Value
toJSONList :: [DirectionDesk] -> Value
$ctoEncodingList :: [DirectionDesk] -> Encoding
toEncodingList :: [DirectionDesk] -> Encoding
A.ToJSON)

type SizeDesk :: Type
data SizeDesk = MkSizeDesk
  { SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskWidth :: ConstrainedDouble '[MkConstraintDoubleGreaterEqual 30, MkConstraintDoubleLessEqual 600]
  , SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskDepth :: ConstrainedDouble '[MkConstraintDoubleGreaterEqual 30, MkConstraintDoubleLessEqual 600]
  }
  deriving stock (SizeDesk -> SizeDesk -> Bool
(SizeDesk -> SizeDesk -> Bool)
-> (SizeDesk -> SizeDesk -> Bool) -> Eq SizeDesk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SizeDesk -> SizeDesk -> Bool
== :: SizeDesk -> SizeDesk -> Bool
$c/= :: SizeDesk -> SizeDesk -> Bool
/= :: SizeDesk -> SizeDesk -> Bool
Eq, (forall x. SizeDesk -> Rep SizeDesk x)
-> (forall x. Rep SizeDesk x -> SizeDesk) -> Generic SizeDesk
forall x. Rep SizeDesk x -> SizeDesk
forall x. SizeDesk -> Rep SizeDesk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SizeDesk -> Rep SizeDesk x
from :: forall x. SizeDesk -> Rep SizeDesk x
$cto :: forall x. Rep SizeDesk x -> SizeDesk
to :: forall x. Rep SizeDesk x -> SizeDesk
Generic, Eq SizeDesk
Eq SizeDesk =>
(SizeDesk -> SizeDesk -> Ordering)
-> (SizeDesk -> SizeDesk -> Bool)
-> (SizeDesk -> SizeDesk -> Bool)
-> (SizeDesk -> SizeDesk -> Bool)
-> (SizeDesk -> SizeDesk -> Bool)
-> (SizeDesk -> SizeDesk -> SizeDesk)
-> (SizeDesk -> SizeDesk -> SizeDesk)
-> Ord SizeDesk
SizeDesk -> SizeDesk -> Bool
SizeDesk -> SizeDesk -> Ordering
SizeDesk -> SizeDesk -> SizeDesk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SizeDesk -> SizeDesk -> Ordering
compare :: SizeDesk -> SizeDesk -> Ordering
$c< :: SizeDesk -> SizeDesk -> Bool
< :: SizeDesk -> SizeDesk -> Bool
$c<= :: SizeDesk -> SizeDesk -> Bool
<= :: SizeDesk -> SizeDesk -> Bool
$c> :: SizeDesk -> SizeDesk -> Bool
> :: SizeDesk -> SizeDesk -> Bool
$c>= :: SizeDesk -> SizeDesk -> Bool
>= :: SizeDesk -> SizeDesk -> Bool
$cmax :: SizeDesk -> SizeDesk -> SizeDesk
max :: SizeDesk -> SizeDesk -> SizeDesk
$cmin :: SizeDesk -> SizeDesk -> SizeDesk
min :: SizeDesk -> SizeDesk -> SizeDesk
Ord, ReadPrec [SizeDesk]
ReadPrec SizeDesk
Int -> ReadS SizeDesk
ReadS [SizeDesk]
(Int -> ReadS SizeDesk)
-> ReadS [SizeDesk]
-> ReadPrec SizeDesk
-> ReadPrec [SizeDesk]
-> Read SizeDesk
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SizeDesk
readsPrec :: Int -> ReadS SizeDesk
$creadList :: ReadS [SizeDesk]
readList :: ReadS [SizeDesk]
$creadPrec :: ReadPrec SizeDesk
readPrec :: ReadPrec SizeDesk
$creadListPrec :: ReadPrec [SizeDesk]
readListPrec :: ReadPrec [SizeDesk]
Read, Int -> SizeDesk -> ShowS
[SizeDesk] -> ShowS
SizeDesk -> String
(Int -> SizeDesk -> ShowS)
-> (SizeDesk -> String) -> ([SizeDesk] -> ShowS) -> Show SizeDesk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizeDesk -> ShowS
showsPrec :: Int -> SizeDesk -> ShowS
$cshow :: SizeDesk -> String
show :: SizeDesk -> String
$cshowList :: [SizeDesk] -> ShowS
showList :: [SizeDesk] -> ShowS
Show)
  deriving
    (Value -> Parser [SizeDesk]
Value -> Parser SizeDesk
(Value -> Parser SizeDesk)
-> (Value -> Parser [SizeDesk]) -> FromJSON SizeDesk
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SizeDesk
parseJSON :: Value -> Parser SizeDesk
$cparseJSONList :: Value -> Parser [SizeDesk]
parseJSONList :: Value -> Parser [SizeDesk]
A.FromJSON, [SizeDesk] -> Value
[SizeDesk] -> Encoding
SizeDesk -> Value
SizeDesk -> Encoding
(SizeDesk -> Value)
-> (SizeDesk -> Encoding)
-> ([SizeDesk] -> Value)
-> ([SizeDesk] -> Encoding)
-> ToJSON SizeDesk
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SizeDesk -> Value
toJSON :: SizeDesk -> Value
$ctoEncoding :: SizeDesk -> Encoding
toEncoding :: SizeDesk -> Encoding
$ctoJSONList :: [SizeDesk] -> Value
toJSONList :: [SizeDesk] -> Value
$ctoEncodingList :: [SizeDesk] -> Encoding
toEncodingList :: [SizeDesk] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "Mk" "sizeDesk") SizeDesk

-- | Direction on a 2D plane given as the angle relativ to North.
--
-- [North]:   0
-- [East]:   90
-- [South]: 180
-- [West]:  270
type Direction :: Type
newtype Direction = MkDirectionDegrees {Direction
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
unDirectionDegrees :: ConstrainedDouble '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]}
  deriving stock (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Direction -> Rep Direction x
from :: forall x. Direction -> Rep Direction x
$cto :: forall x. Rep Direction x -> Direction
to :: forall x. Rep Direction x -> Direction
Generic, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show)
  deriving newtype (Value -> Parser [Direction]
Value -> Parser Direction
(Value -> Parser Direction)
-> (Value -> Parser [Direction]) -> FromJSON Direction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Direction
parseJSON :: Value -> Parser Direction
$cparseJSONList :: Value -> Parser [Direction]
parseJSONList :: Value -> Parser [Direction]
A.FromJSON, [Direction] -> Value
[Direction] -> Encoding
Direction -> Value
Direction -> Encoding
(Direction -> Value)
-> (Direction -> Encoding)
-> ([Direction] -> Value)
-> ([Direction] -> Encoding)
-> ToJSON Direction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Direction -> Value
toJSON :: Direction -> Value
$ctoEncoding :: Direction -> Encoding
toEncoding :: Direction -> Encoding
$ctoJSONList :: [Direction] -> Value
toJSONList :: [Direction] -> Value
$ctoEncodingList :: [Direction] -> Encoding
toEncodingList :: [Direction] -> Encoding
A.ToJSON)

type ConstrainedDouble :: [ConstraintDouble] -> Type
newtype ConstrainedDouble constraints = MkConstrainedDoubleUnsafe {forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble :: Double}
  deriving stock (ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
(ConstrainedDouble constraints
 -> ConstrainedDouble constraints -> Bool)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> Bool)
-> Eq (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
== :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
$c/= :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
/= :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
Eq, (forall x.
 ConstrainedDouble constraints
 -> Rep (ConstrainedDouble constraints) x)
-> (forall x.
    Rep (ConstrainedDouble constraints) x
    -> ConstrainedDouble constraints)
-> Generic (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]) x.
Rep (ConstrainedDouble constraints) x
-> ConstrainedDouble constraints
forall (constraints :: [ConstraintDouble]) x.
ConstrainedDouble constraints
-> Rep (ConstrainedDouble constraints) x
forall x.
Rep (ConstrainedDouble constraints) x
-> ConstrainedDouble constraints
forall x.
ConstrainedDouble constraints
-> Rep (ConstrainedDouble constraints) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (constraints :: [ConstraintDouble]) x.
ConstrainedDouble constraints
-> Rep (ConstrainedDouble constraints) x
from :: forall x.
ConstrainedDouble constraints
-> Rep (ConstrainedDouble constraints) x
$cto :: forall (constraints :: [ConstraintDouble]) x.
Rep (ConstrainedDouble constraints) x
-> ConstrainedDouble constraints
to :: forall x.
Rep (ConstrainedDouble constraints) x
-> ConstrainedDouble constraints
Generic, Eq (ConstrainedDouble constraints)
Eq (ConstrainedDouble constraints) =>
(ConstrainedDouble constraints
 -> ConstrainedDouble constraints -> Ordering)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> Bool)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> Bool)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> Bool)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> Bool)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> ConstrainedDouble constraints)
-> (ConstrainedDouble constraints
    -> ConstrainedDouble constraints -> ConstrainedDouble constraints)
-> Ord (ConstrainedDouble constraints)
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Ordering
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
forall (constraints :: [ConstraintDouble]).
Eq (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Ordering
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Ordering
compare :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Ordering
$c< :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
< :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
$c<= :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
<= :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
$c> :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
> :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
$c>= :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
>= :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> Bool
$cmax :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
max :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
$cmin :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
min :: ConstrainedDouble constraints
-> ConstrainedDouble constraints -> ConstrainedDouble constraints
Ord, ReadPrec [ConstrainedDouble constraints]
ReadPrec (ConstrainedDouble constraints)
Int -> ReadS (ConstrainedDouble constraints)
ReadS [ConstrainedDouble constraints]
(Int -> ReadS (ConstrainedDouble constraints))
-> ReadS [ConstrainedDouble constraints]
-> ReadPrec (ConstrainedDouble constraints)
-> ReadPrec [ConstrainedDouble constraints]
-> Read (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
ReadPrec [ConstrainedDouble constraints]
forall (constraints :: [ConstraintDouble]).
ReadPrec (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
Int -> ReadS (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
ReadS [ConstrainedDouble constraints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall (constraints :: [ConstraintDouble]).
Int -> ReadS (ConstrainedDouble constraints)
readsPrec :: Int -> ReadS (ConstrainedDouble constraints)
$creadList :: forall (constraints :: [ConstraintDouble]).
ReadS [ConstrainedDouble constraints]
readList :: ReadS [ConstrainedDouble constraints]
$creadPrec :: forall (constraints :: [ConstraintDouble]).
ReadPrec (ConstrainedDouble constraints)
readPrec :: ReadPrec (ConstrainedDouble constraints)
$creadListPrec :: forall (constraints :: [ConstraintDouble]).
ReadPrec [ConstrainedDouble constraints]
readListPrec :: ReadPrec [ConstrainedDouble constraints]
Read, Int -> ConstrainedDouble constraints -> ShowS
[ConstrainedDouble constraints] -> ShowS
ConstrainedDouble constraints -> String
(Int -> ConstrainedDouble constraints -> ShowS)
-> (ConstrainedDouble constraints -> String)
-> ([ConstrainedDouble constraints] -> ShowS)
-> Show (ConstrainedDouble constraints)
forall (constraints :: [ConstraintDouble]).
Int -> ConstrainedDouble constraints -> ShowS
forall (constraints :: [ConstraintDouble]).
[ConstrainedDouble constraints] -> ShowS
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (constraints :: [ConstraintDouble]).
Int -> ConstrainedDouble constraints -> ShowS
showsPrec :: Int -> ConstrainedDouble constraints -> ShowS
$cshow :: forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> String
show :: ConstrainedDouble constraints -> String
$cshowList :: forall (constraints :: [ConstraintDouble]).
[ConstrainedDouble constraints] -> ShowS
showList :: [ConstrainedDouble constraints] -> ShowS
Show)

instance A.FromJSON (ConstrainedDouble '[]) where
  parseJSON :: Value -> Parser (ConstrainedDouble '[])
parseJSON Value
val = do
    Double
parsedDouble <- Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
val
    if Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) Bool -> Bool -> Bool
&& Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
-1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
      then ConstrainedDouble '[] -> Parser (ConstrainedDouble '[])
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConstrainedDoubleUnsafe {unConstrainedDouble :: Double
unConstrainedDouble = Double
parsedDouble}
      else String -> Parser (ConstrainedDouble '[])
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parsing constrained double failed: Not a number"
instance (A.FromJSON (ConstrainedDouble cs), KnownNat n) => A.FromJSON (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs)) where
  parseJSON :: Value
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs))
parseJSON Value
val = do
    ConstrainedDouble cs
parsedConstrainedDouble :: ConstrainedDouble cs <- Value -> Parser (ConstrainedDouble cs)
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
val
    let
      parsedDouble :: Double
parsedDouble = ConstrainedDouble cs -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble ConstrainedDouble cs
parsedConstrainedDouble
      minGEDouble :: Double
minGEDouble = Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
    if Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
minGEDouble
      then ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs)
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConstrainedDoubleUnsafe {unConstrainedDouble :: Double
unConstrainedDouble = Double
parsedDouble}
      else String
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs)))
-> String
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterEqual n : cs))
forall a b. (a -> b) -> a -> b
$ String
"Parsing constrained double failed: Expected n >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
minGEDouble
instance (A.FromJSON (ConstrainedDouble cs), KnownNat n) => A.FromJSON (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs)) where
  parseJSON :: Value
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs))
parseJSON Value
val = do
    ConstrainedDouble cs
parsedConstrainedDouble :: ConstrainedDouble cs <- Value -> Parser (ConstrainedDouble cs)
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
val
    let
      parsedDouble :: Double
parsedDouble = ConstrainedDouble cs -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble ConstrainedDouble cs
parsedConstrainedDouble
      minGTDouble :: Double
minGTDouble = Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
    if Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
minGTDouble
      then ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs)
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConstrainedDoubleUnsafe {unConstrainedDouble :: Double
unConstrainedDouble = Double
parsedDouble}
      else String
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser
      (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs)))
-> String
-> Parser
     (ConstrainedDouble (MkConstraintDoubleGreaterThan n : cs))
forall a b. (a -> b) -> a -> b
$ String
"Parsing constrained double failed: Expected n > " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
minGTDouble
instance (A.FromJSON (ConstrainedDouble cs), KnownNat n) => A.FromJSON (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs)) where
  parseJSON :: Value
-> Parser (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs))
parseJSON Value
val = do
    ConstrainedDouble cs
parsedConstrainedDouble :: ConstrainedDouble cs <- Value -> Parser (ConstrainedDouble cs)
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
val
    let
      parsedDouble :: Double
parsedDouble = ConstrainedDouble cs -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble ConstrainedDouble cs
parsedConstrainedDouble
      maxLEDouble :: Double
maxLEDouble = Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
    if Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
maxLEDouble
      then ConstrainedDouble (MkConstraintDoubleLessEqual n : cs)
-> Parser (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConstrainedDoubleUnsafe {unConstrainedDouble :: Double
unConstrainedDouble = Double
parsedDouble}
      else String
-> Parser (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs)))
-> String
-> Parser (ConstrainedDouble (MkConstraintDoubleLessEqual n : cs))
forall a b. (a -> b) -> a -> b
$ String
"Parsing constrained double failed: Expected n <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
maxLEDouble
instance (A.FromJSON (ConstrainedDouble cs), KnownNat n) => A.FromJSON (ConstrainedDouble (MkConstraintDoubleLessThan n : cs)) where
  parseJSON :: Value
-> Parser (ConstrainedDouble (MkConstraintDoubleLessThan n : cs))
parseJSON Value
val = do
    ConstrainedDouble cs
parsedConstrainedDouble :: ConstrainedDouble cs <- Value -> Parser (ConstrainedDouble cs)
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
val
    let
      parsedDouble :: Double
parsedDouble = ConstrainedDouble cs -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble ConstrainedDouble cs
parsedConstrainedDouble
      maxLTDouble :: Double
maxLTDouble = Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
    if Double
parsedDouble Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
maxLTDouble
      then ConstrainedDouble (MkConstraintDoubleLessThan n : cs)
-> Parser (ConstrainedDouble (MkConstraintDoubleLessThan n : cs))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConstrainedDoubleUnsafe {unConstrainedDouble :: Double
unConstrainedDouble = Double
parsedDouble}
      else String
-> Parser (ConstrainedDouble (MkConstraintDoubleLessThan n : cs))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser (ConstrainedDouble (MkConstraintDoubleLessThan n : cs)))
-> String
-> Parser (ConstrainedDouble (MkConstraintDoubleLessThan n : cs))
forall a b. (a -> b) -> a -> b
$ String
"Parsing constrained double failed: Expected n < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
maxLTDouble
deriving newtype instance A.ToJSON (ConstrainedDouble cs)

type ConstraintDouble :: Type
type data ConstraintDouble
  = MkConstraintDoubleGreaterEqual Natural
  | MkConstraintDoubleGreaterThan Natural
  | MkConstraintDoubleLessEqual Natural
  | MkConstraintDoubleLessThan Natural