{-# LANGUAGE OverloadedLists #-}

module Telescope.Asdf.Core where

import Data.String (fromString)
import Data.Text (Text)
import Data.Version (showVersion)
import Effectful
import Effectful.Error.Static
import GHC.Generics (Generic)
import Paths_telescope (version)
import Telescope.Asdf.Class
import Telescope.Asdf.Error (AsdfError (..))
import Telescope.Asdf.Node
import Telescope.Data.Parser (expected)


{- | VOUnit: https://www.ivoa.net/documents/VOUnits/20231215/REC-VOUnits-1.1.html
 -
Unrecognised units should be accepted by parsers, as long as they are parsed giving preference to the syntaxes and prefixes described here.
-}
data Unit
  = Count
  | Pixel
  | Degrees
  | Nanometers
  | Unit Text
  deriving (Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
/= :: Unit -> Unit -> Bool
Eq)


instance ToAsdf Unit where
  schema :: Unit -> SchemaTag
schema Unit
_ = SchemaTag
"!unit/unit-1.0.0"
  toValue :: Unit -> Value
toValue = \case
    Unit
Count -> Value
"count"
    Unit
Pixel -> Value
"pixel"
    Unit
Degrees -> Value
"deg"
    Unit
Nanometers -> Value
"nm"
    (Unit Text
t) -> Text -> Value
String Text
t
instance FromAsdf Unit where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Unit
parseValue = \case
    String Text
"count" -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Count
    String Text
"deg" -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Degrees
    String Text
"pixel" -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Pixel
    String Text
"pix" -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Pixel
    String Text
"nm" -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
Nanometers
    String Text
t -> Unit -> Eff es Unit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Unit -> Eff es Unit) -> Unit -> Eff es Unit
forall a b. (a -> b) -> a -> b
$ Text -> Unit
Unit Text
t
    Value
val -> String -> Value -> Eff es Unit
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"String" Value
val


-- | Tag a value with a 'Unit'
data Quantity = Quantity
  { Quantity -> Unit
unit :: Unit
  , Quantity -> Value
value :: Value
  }
  deriving ((forall x. Quantity -> Rep Quantity x)
-> (forall x. Rep Quantity x -> Quantity) -> Generic Quantity
forall x. Rep Quantity x -> Quantity
forall x. Quantity -> Rep Quantity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Quantity -> Rep Quantity x
from :: forall x. Quantity -> Rep Quantity x
$cto :: forall x. Rep Quantity x -> Quantity
to :: forall x. Rep Quantity x -> Quantity
Generic)


instance ToAsdf Quantity where
  schema :: Quantity -> SchemaTag
schema Quantity
_ = SchemaTag
"!unit/quantity-1.1.0"
instance FromAsdf Quantity


--
-- -- TEST: this is probably index dependent
-- data BoundingBox = BoundingBox Double Double
--
--
-- instance ToAsdf BoundingBox where
--   toValue (BoundingBox a b) =
--     Array
--       [ toNode $ Quantity Pixel (toValue a)
--       , toNode $ Quantity Pixel (toValue b)
--       ]
--
--
-- instance FromAsdf BoundingBox where
--   parseValue = \case
--     Array [n1, n2] -> do
--       BoundingBox <$> parseNode n1 <*> parseNode n2
--     node -> expected "BoundingBox" node

-- | Required Software node at the top-level
data Software = Software
  { Software -> Maybe Text
author :: Maybe Text
  , Software -> Maybe Text
homepage :: Maybe Text
  , Software -> Text
name :: Text
  , Software -> Text
version :: Text
  }
  deriving (Int -> Software -> ShowS
[Software] -> ShowS
Software -> String
(Int -> Software -> ShowS)
-> (Software -> String) -> ([Software] -> ShowS) -> Show Software
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Software -> ShowS
showsPrec :: Int -> Software -> ShowS
$cshow :: Software -> String
show :: Software -> String
$cshowList :: [Software] -> ShowS
showList :: [Software] -> ShowS
Show, Software -> Software -> Bool
(Software -> Software -> Bool)
-> (Software -> Software -> Bool) -> Eq Software
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Software -> Software -> Bool
== :: Software -> Software -> Bool
$c/= :: Software -> Software -> Bool
/= :: Software -> Software -> Bool
Eq, (forall x. Software -> Rep Software x)
-> (forall x. Rep Software x -> Software) -> Generic Software
forall x. Rep Software x -> Software
forall x. Software -> Rep Software x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Software -> Rep Software x
from :: forall x. Software -> Rep Software x
$cto :: forall x. Rep Software x -> Software
to :: forall x. Rep Software x -> Software
Generic, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es Software)
-> FromAsdf Software
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Software
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Software
parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Software
FromAsdf)


instance ToAsdf Software where
  schema :: Software -> SchemaTag
schema Software
_ = SchemaTag
"!core/software-1.0.0"


-- | Root ASDF node
data Asdf = Asdf
  { Asdf -> History
history :: History
  , Asdf -> Software
library :: Software
  , Asdf -> Tree
tree :: Tree
  }


instance ToAsdf Asdf where
  schema :: Asdf -> SchemaTag
schema Asdf
_ = SchemaTag
"!core/asdf-1.1.0"
  toValue :: Asdf -> Value
toValue Asdf
a =
    let Tree Object
tree = Asdf
a.tree
     in -- these two required fields are first, then merge keys from the tree
        Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
          [ (Text
"asdf_library", Software -> Node
forall a. ToAsdf a => a -> Node
toNode Asdf
a.library)
          , (Text
"history", History -> Node
forall a. ToAsdf a => a -> Node
toNode Asdf
a.history)
          ]
            Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
tree
instance FromAsdf Asdf where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Asdf
parseValue = \case
    Object Object
o -> do
      Software
library <- Object
o Object -> Text -> Eff es Software
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es a
.: Text
"asdf_library"
      History
history <- Object
o Object -> Text -> Eff es History
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es a
.: Text
"history"
      let tree :: Tree
tree = Object -> Tree
Tree (Object -> Tree) -> Object -> Tree
forall a b. (a -> b) -> a -> b
$ ((Text, Node) -> Bool) -> Object -> Object
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Text, Node) -> Bool) -> (Text, Node) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Node) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isLibraryField) Object
o
      Asdf -> Eff es Asdf
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Asdf -> Eff es Asdf) -> Asdf -> Eff es Asdf
forall a b. (a -> b) -> a -> b
$ Asdf{History
history :: History
history :: History
history, Software
library :: Software
library :: Software
library, Tree
tree :: Tree
tree :: Tree
tree}
    Value
val -> String -> Value -> Eff es Asdf
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Asdf" Value
val
   where
    isLibraryField :: (a, b) -> Bool
isLibraryField (a
"asdf_library", b
_) = Bool
True
    isLibraryField (a
"history", b
_) = Bool
True
    isLibraryField (a, b)
_ = Bool
False


-- | Convert any ToAsdf into a raw Asdf document
toAsdfDoc :: (ToAsdf a, Error AsdfError :> es) => a -> Eff es Asdf
toAsdfDoc :: forall a (es :: [Effect]).
(ToAsdf a, Error AsdfError :> es) =>
a -> Eff es Asdf
toAsdfDoc a
a =
  case a -> Value
forall a. ToAsdf a => a -> Value
toValue a
a of
    Object Object
o -> do
      let history :: History
history = [ExtensionMetadata] -> History
History []
      let library :: Software
library = Software
telescopeLibrary
      Asdf -> Eff es Asdf
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Asdf -> Eff es Asdf) -> Asdf -> Eff es Asdf
forall a b. (a -> b) -> a -> b
$ Asdf{History
history :: History
history :: History
history, Software
library :: Software
library :: Software
library, tree :: Tree
tree = Object -> Tree
Tree Object
o}
    Value
value -> AsdfError -> Eff es Asdf
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (AsdfError -> Eff es Asdf) -> AsdfError -> Eff es Asdf
forall a b. (a -> b) -> a -> b
$ String -> AsdfError
EncodeError (String -> AsdfError) -> String -> AsdfError
forall a b. (a -> b) -> a -> b
$ String
"Expected Top-level Tree Object, but got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value
 where
  telescopeLibrary :: Software
  telescopeLibrary :: Software
telescopeLibrary =
    Software
      { author :: Maybe Text
author = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"DKIST Data Center"
      , homepage :: Maybe Text
homepage = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"https://github.com/dkistdc/telescope.hs"
      , name :: Text
name = Text
"telescope.hs"
      , version :: Text
version = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version
      }


data History = History
  { History -> [ExtensionMetadata]
extensions :: [ExtensionMetadata]
  }
  deriving (Int -> History -> ShowS
[History] -> ShowS
History -> String
(Int -> History -> ShowS)
-> (History -> String) -> ([History] -> ShowS) -> Show History
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> History -> ShowS
showsPrec :: Int -> History -> ShowS
$cshow :: History -> String
show :: History -> String
$cshowList :: [History] -> ShowS
showList :: [History] -> ShowS
Show, (forall x. History -> Rep History x)
-> (forall x. Rep History x -> History) -> Generic History
forall x. Rep History x -> History
forall x. History -> Rep History x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. History -> Rep History x
from :: forall x. History -> Rep History x
$cto :: forall x. Rep History x -> History
to :: forall x. Rep History x -> History
Generic, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es History)
-> FromAsdf History
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es History
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es History
parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es History
FromAsdf, History -> Maybe Anchor
History -> Value
History -> Node
History -> SchemaTag
(History -> Value)
-> (History -> SchemaTag)
-> (History -> Maybe Anchor)
-> (History -> Node)
-> ToAsdf History
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: History -> Value
toValue :: History -> Value
$cschema :: History -> SchemaTag
schema :: History -> SchemaTag
$canchor :: History -> Maybe Anchor
anchor :: History -> Maybe Anchor
$ctoNode :: History -> Node
toNode :: History -> Node
ToAsdf)


data ExtensionMetadata = ExtensionMetadata
  { ExtensionMetadata -> Text
extension_class :: Text
  , ExtensionMetadata -> Software
software :: Software
  }
  deriving (Int -> ExtensionMetadata -> ShowS
[ExtensionMetadata] -> ShowS
ExtensionMetadata -> String
(Int -> ExtensionMetadata -> ShowS)
-> (ExtensionMetadata -> String)
-> ([ExtensionMetadata] -> ShowS)
-> Show ExtensionMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionMetadata -> ShowS
showsPrec :: Int -> ExtensionMetadata -> ShowS
$cshow :: ExtensionMetadata -> String
show :: ExtensionMetadata -> String
$cshowList :: [ExtensionMetadata] -> ShowS
showList :: [ExtensionMetadata] -> ShowS
Show, (forall x. ExtensionMetadata -> Rep ExtensionMetadata x)
-> (forall x. Rep ExtensionMetadata x -> ExtensionMetadata)
-> Generic ExtensionMetadata
forall x. Rep ExtensionMetadata x -> ExtensionMetadata
forall x. ExtensionMetadata -> Rep ExtensionMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtensionMetadata -> Rep ExtensionMetadata x
from :: forall x. ExtensionMetadata -> Rep ExtensionMetadata x
$cto :: forall x. Rep ExtensionMetadata x -> ExtensionMetadata
to :: forall x. Rep ExtensionMetadata x -> ExtensionMetadata
Generic, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es ExtensionMetadata)
-> FromAsdf ExtensionMetadata
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es ExtensionMetadata
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es ExtensionMetadata
parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es ExtensionMetadata
FromAsdf)
instance ToAsdf ExtensionMetadata where
  schema :: ExtensionMetadata -> SchemaTag
schema ExtensionMetadata
_ = SchemaTag
"!core/extension_metadata-1.0.0"