module Telescope.Fits.Header.Class where

import Data.Fits as Fits hiding (isKeyword)
import Data.Text (Text, pack)
import Data.Text qualified as T
import Effectful
import GHC.Generics
import Telescope.Data.Axes (AxisOrder (..))
import Telescope.Data.KnownText
import Telescope.Data.Parser
import Telescope.Data.WCS (CType (..), CUnit (..), WCSAxis (..), toWCSAxisKey)
import Telescope.Fits.Header.Keyword (lookupKeyword)
import Text.Casing (fromHumps, toSnake)


class ToKeyword a where
  toKeywordValue :: a -> Value


  -- Can ignore the selector name, modify it, etc
  toKeywordRecord :: Text -> a -> KeywordRecord
  default toKeywordRecord :: Text -> a -> KeywordRecord
  toKeywordRecord Text
key a
a =
    Text -> Value -> Maybe Text -> KeywordRecord
KeywordRecord Text
key (a -> Value
forall a. ToKeyword a => a -> Value
toKeywordValue a
a) Maybe Text
forall a. Maybe a
Nothing


instance ToKeyword Int where
  toKeywordValue :: Int -> Value
toKeywordValue = Int -> Value
Integer
instance FromKeyword Int where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int
parseKeywordValue = \case
    Integer Int
n -> Int -> Eff es Int
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
    Value
v -> String -> Value -> Eff es Int
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Integer" Value
v


instance ToKeyword Float where
  toKeywordValue :: Float -> Value
toKeywordValue = Float -> Value
Float
instance FromKeyword Float where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Float
parseKeywordValue = \case
    Float Float
n -> Float -> Eff es Float
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
n
    Value
v -> String -> Value -> Eff es Float
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Float" Value
v


instance ToKeyword Text where
  toKeywordValue :: Text -> Value
toKeywordValue = Text -> Value
String
instance FromKeyword Text where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Text
parseKeywordValue = \case
    String Text
n -> Text -> Eff es Text
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
    Value
v -> String -> Value -> Eff es Text
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"String" Value
v


instance ToKeyword Bool where
  toKeywordValue :: Bool -> Value
toKeywordValue Bool
True = LogicalConstant -> Value
Logic LogicalConstant
T
  toKeywordValue Bool
False = LogicalConstant -> Value
Logic LogicalConstant
F
instance FromKeyword Bool where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Bool
parseKeywordValue = \case
    Logic LogicalConstant
c -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Eff es Bool) -> Bool -> Eff es Bool
forall a b. (a -> b) -> a -> b
$ LogicalConstant
c LogicalConstant -> LogicalConstant -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalConstant
T
    Value
v -> String -> Value -> Eff es Bool
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Logic" Value
v


instance ToKeyword CUnit where
  toKeywordValue :: CUnit -> Value
toKeywordValue (CUnit Text
t) = Text -> Value
forall a. ToKeyword a => a -> Value
toKeywordValue Text
t
instance FromKeyword CUnit where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es CUnit
parseKeywordValue = \case
    String Text
t -> CUnit -> Eff es CUnit
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CUnit -> Eff es CUnit) -> CUnit -> Eff es CUnit
forall a b. (a -> b) -> a -> b
$ Text -> CUnit
CUnit Text
t
    Value
v -> String -> Value -> Eff es CUnit
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"CUnit" Value
v


instance ToKeyword CType where
  toKeywordValue :: CType -> Value
toKeywordValue (CType Text
t) = Text -> Value
forall a. ToKeyword a => a -> Value
toKeywordValue Text
t
instance FromKeyword CType where
  parseKeywordValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es CType
parseKeywordValue = \case
    String Text
t -> CType -> Eff es CType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CType -> Eff es CType) -> CType -> Eff es CType
forall a b. (a -> b) -> a -> b
$ Text -> CType
CType Text
t
    Value
v -> String -> Value -> Eff es CType
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"CType" Value
v


class FromKeyword a where
  parseKeywordValue :: (Parser :> es) => Value -> Eff es a


class ToHeader a where
  toHeader :: a -> Header
  default toHeader :: (Generic a, GToHeader (Rep a)) => a -> Header
  toHeader = Rep a Any -> Header
forall p. Rep a p -> Header
forall {k} (f :: k -> *) (p :: k). GToHeader f => f p -> Header
gToHeader (Rep a Any -> Header) -> (a -> Rep a Any) -> a -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from


instance (ToHeader a) => ToHeader (Maybe a) where
  toHeader :: Maybe a -> Header
toHeader Maybe a
Nothing = Header
forall a. Monoid a => a
mempty
  toHeader (Just a
a) = a -> Header
forall a. ToHeader a => a -> Header
toHeader a
a


instance (ToHeader a) => ToHeader [a] where
  toHeader :: [a] -> Header
toHeader = [Header] -> Header
forall a. Monoid a => [a] -> a
mconcat ([Header] -> Header) -> ([a] -> [Header]) -> [a] -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Header) -> [a] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Header
forall a. ToHeader a => a -> Header
toHeader


instance (AxisOrder ax, KnownText alt) => ToHeader (WCSAxis alt ax) where
  toHeader :: WCSAxis alt ax -> Header
toHeader WCSAxis alt ax
axis =
    [Header] -> Header
forall a. Monoid a => [a] -> a
mconcat
      [ String -> CType -> Header
forall a. ToKeyword a => String -> a -> Header
axisKey String
"ctype" WCSAxis alt ax
axis.ctype
      , String -> CUnit -> Header
forall a. ToKeyword a => String -> a -> Header
axisKey String
"cunit" WCSAxis alt ax
axis.cunit
      , String -> Float -> Header
forall a. ToKeyword a => String -> a -> Header
axisKey String
"crpix" WCSAxis alt ax
axis.crpix
      , String -> Float -> Header
forall a. ToKeyword a => String -> a -> Header
axisKey String
"crval" WCSAxis alt ax
axis.crval
      , String -> Float -> Header
forall a. ToKeyword a => String -> a -> Header
axisKey String
"cdelt" WCSAxis alt ax
axis.cdelt
      ]
   where
    axisKey :: (ToKeyword a) => String -> a -> Header
    axisKey :: forall a. ToKeyword a => String -> a -> Header
axisKey String
s a
a =
      [HeaderRecord] -> Header
Header [KeywordRecord -> HeaderRecord
Keyword (KeywordRecord -> HeaderRecord) -> KeywordRecord -> HeaderRecord
forall a b. (a -> b) -> a -> b
$ Text -> a -> KeywordRecord
forall a. ToKeyword a => Text -> a -> KeywordRecord
toKeywordRecord (String -> Text
keyword String
s) a
a]

    keyword :: String -> Text
keyword String
s = forall {k1} {k2} (alt :: k1) (ax :: k2).
(KnownText alt, AxisOrder ax) =>
Text -> Text
forall (alt :: WCSAlt) (ax :: k).
(KnownText alt, AxisOrder ax) =>
Text -> Text
toWCSAxisKey @alt @ax (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
cleanKeyword String
s


class FromHeader a where
  parseHeader :: (Parser :> es) => Header -> Eff es a
  default parseHeader :: (Generic a, GFromHeader (Rep a), Parser :> es) => Header -> Eff es a
  parseHeader Header
h = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Eff es (Rep a Any) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header -> Eff es (Rep a Any)
forall (es :: [Effect]) p.
(Parser :> es) =>
Header -> Eff es (Rep a p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GFromHeader f, Parser :> es) =>
Header -> Eff es (f p)
gParseHeader Header
h


instance (AxisOrder ax, KnownText alt) => FromHeader (WCSAxis alt ax) where
  parseHeader :: forall (es :: [Effect]).
(Parser :> es) =>
Header -> Eff es (WCSAxis alt ax)
parseHeader Header
h = do
    CType
ctype <- String -> Header -> Eff es CType
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
"ctype" Header
h
    CUnit
cunit <- String -> Header -> Eff es CUnit
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
"cunit" Header
h
    Float
crpix <- String -> Header -> Eff es Float
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
"crpix" Header
h
    Float
crval <- String -> Header -> Eff es Float
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
"crval" Header
h
    Float
cdelt <- String -> Header -> Eff es Float
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
"cdelt" Header
h
    WCSAxis alt ax -> Eff es (WCSAxis alt ax)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WCSAxis alt ax -> Eff es (WCSAxis alt ax))
-> WCSAxis alt ax -> Eff es (WCSAxis alt ax)
forall a b. (a -> b) -> a -> b
$ WCSAxis{CType
ctype :: CType
ctype :: CType
ctype, CUnit
cunit :: CUnit
cunit :: CUnit
cunit, Float
crpix :: Float
crpix :: Float
crpix, Float
crval :: Float
crval :: Float
crval, Float
cdelt :: Float
cdelt :: Float
cdelt}
   where
    parseAxisKey :: (FromKeyword a, Parser :> es) => String -> Header -> Eff es a
    parseAxisKey :: forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
String -> Header -> Eff es a
parseAxisKey String
k = do
      Text -> Header -> Eff es a
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
Text -> Header -> Eff es a
parseKeyword (forall {k1} {k2} (alt :: k1) (ax :: k2).
(KnownText alt, AxisOrder ax) =>
Text -> Text
forall (alt :: WCSAlt) (ax :: k).
(KnownText alt, AxisOrder ax) =>
Text -> Text
toWCSAxisKey @alt @ax (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
cleanKeyword String
k)


parseKeyword :: (FromKeyword a, Parser :> es) => Text -> Header -> Eff es a
parseKeyword :: forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
Text -> Header -> Eff es a
parseKeyword Text
k Header
h =
  case Text -> Header -> Maybe Value
Fits.lookup Text
k Header
h of
    Maybe Value
Nothing -> String -> Eff es a
forall (es :: [Effect]) a. (Parser :> es) => String -> Eff es a
parseFail (String -> Eff es a) -> String -> Eff es a
forall a b. (a -> b) -> a -> b
$ String
"Missing key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k
    Just Value
v -> Ref -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
k) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
Value -> Eff es a
parseKeywordValue Value
v


class GToHeader f where
  gToHeader :: f p -> Header


instance (GToHeader f) => GToHeader (M1 D c f) where
  gToHeader :: forall (p :: k). M1 D c f p -> Header
gToHeader (M1 f p
f) = f p -> Header
forall (p :: k). f p -> Header
forall {k} (f :: k -> *) (p :: k). GToHeader f => f p -> Header
gToHeader f p
f


instance (GToHeader f) => GToHeader (M1 C c f) where
  gToHeader :: forall (p :: k). M1 C c f p -> Header
gToHeader (M1 f p
f) = f p -> Header
forall (p :: k). f p -> Header
forall {k} (f :: k -> *) (p :: k). GToHeader f => f p -> Header
gToHeader f p
f


instance (GToHeader f, GToHeader g) => GToHeader (f :*: g) where
  gToHeader :: forall (p :: k). (:*:) f g p -> Header
gToHeader (f p
f :*: g p
g) = f p -> Header
forall (p :: k). f p -> Header
forall {k} (f :: k -> *) (p :: k). GToHeader f => f p -> Header
gToHeader f p
f Header -> Header -> Header
forall a. Semigroup a => a -> a -> a
<> g p -> Header
forall (p :: k). g p -> Header
forall {k} (f :: k -> *) (p :: k). GToHeader f => f p -> Header
gToHeader g p
g


instance {-# OVERLAPPABLE #-} (ToKeyword a, Selector s) => GToHeader (M1 S s (K1 R a)) where
  gToHeader :: forall (p :: k). M1 S s (K1 R a) p -> Header
gToHeader (M1 (K1 a
a)) = String -> a -> Header
forall a. ToKeyword a => String -> a -> Header
keywordForField (M1 S s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {k} {f :: k -> *} {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)) a
a


instance {-# OVERLAPS #-} (ToKeyword a, Selector s) => GToHeader (M1 S s (K1 R (Maybe a))) where
  gToHeader :: forall (p :: k). M1 S s (K1 R (Maybe a)) p -> Header
gToHeader (M1 (K1 Maybe a
Nothing)) = [HeaderRecord] -> Header
Header []
  gToHeader (M1 (K1 (Just a
a))) = String -> a -> Header
forall a. ToKeyword a => String -> a -> Header
keywordForField (M1 S s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {k} {f :: k -> *} {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)) a
a


instance {-# OVERLAPS #-} (ToHeader a, Selector s) => GToHeader (M1 S s (K1 R (HeaderFor a))) where
  gToHeader :: forall (p :: k). M1 S s (K1 R (HeaderFor a)) p -> Header
gToHeader (M1 (K1 (HeaderFor a
a))) = a -> Header
forall a. ToHeader a => a -> Header
toHeader a
a


class GFromHeader f where
  gParseHeader :: (Parser :> es) => Header -> Eff es (f p)


instance (GFromHeader f) => GFromHeader (M1 D c f) where
  gParseHeader :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (M1 D c f p)
gParseHeader Header
h = f p -> M1 D c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c f p) -> Eff es (f p) -> Eff es (M1 D c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GFromHeader f, Parser :> es) =>
Header -> Eff es (f p)
gParseHeader Header
h


instance (GFromHeader f) => GFromHeader (M1 C c f) where
  gParseHeader :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (M1 C c f p)
gParseHeader Header
h = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p) -> Eff es (f p) -> Eff es (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GFromHeader f, Parser :> es) =>
Header -> Eff es (f p)
gParseHeader Header
h


instance (GFromHeader f, GFromHeader g) => GFromHeader (f :*: g) where
  gParseHeader :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es ((:*:) f g p)
gParseHeader Header
h = do
    f p
f <- Header -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GFromHeader f, Parser :> es) =>
Header -> Eff es (f p)
gParseHeader Header
h
    g p
g <- Header -> Eff es (g p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (g p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GFromHeader f, Parser :> es) =>
Header -> Eff es (f p)
gParseHeader Header
h
    (:*:) f g p -> Eff es ((:*:) f g p)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Eff es ((:*:) f g p))
-> (:*:) f g p -> Eff es ((:*:) f g p)
forall a b. (a -> b) -> a -> b
$ f p
f f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
g


instance {-# OVERLAPPABLE #-} (FromKeyword a, Selector s) => GFromHeader (M1 S s (K1 R a)) where
  gParseHeader :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (M1 S s (K1 R a) p)
gParseHeader Header
h = do
    let k :: Text
k = String -> Text
cleanKeyword (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 S s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {k} {f :: k -> *} {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)
    K1 R a p -> M1 S s (K1 R a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> M1 S s (K1 R a) p)
-> (a -> K1 R a p) -> a -> M1 S s (K1 R a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> M1 S s (K1 R a) p) -> Eff es a -> Eff es (M1 S s (K1 R a) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Header -> Eff es a
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
Text -> Header -> Eff es a
parseKeyword Text
k Header
h


instance {-# OVERLAPS #-} (FromKeyword a, Selector s) => GFromHeader (M1 S s (K1 R (Maybe a))) where
  gParseHeader :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Header -> Eff es (M1 S s (K1 R (Maybe a)) p)
gParseHeader Header
h = do
    let k :: Text
k = String -> Text
cleanKeyword (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 S s Any Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {k} {f :: k -> *} {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)
    let mval :: Maybe Value
mval = Text -> Header -> Maybe Value
lookupKeyword Text
k Header
h :: Maybe Value
    K1 R (Maybe a) p -> M1 S s (K1 R (Maybe a)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R (Maybe a) p -> M1 S s (K1 R (Maybe a)) p)
-> (Maybe a -> K1 R (Maybe a) p)
-> Maybe a
-> M1 S s (K1 R (Maybe a)) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> K1 R (Maybe a) p
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe a -> M1 S s (K1 R (Maybe a)) p)
-> Eff es (Maybe a) -> Eff es (M1 S s (K1 R (Maybe a)) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Value
mval of
      Maybe Value
Nothing -> Maybe a -> Eff es (Maybe a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      Just Value
v -> do
        a
a <- Ref -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
k) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromKeyword a, Parser :> es) =>
Value -> Eff es a
parseKeywordValue Value
v
        Maybe a -> Eff es (Maybe a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Eff es (Maybe a)) -> Maybe a -> Eff es (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a


cleanKeyword :: String -> Text
cleanKeyword :: String -> Text
cleanKeyword = Text -> Text
T.toUpper (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> String
toSnake (Identifier String -> String)
-> (String -> Identifier String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
fromHumps


newtype HeaderFor a = HeaderFor a


keywordForField :: (ToKeyword a) => String -> a -> Header
keywordForField :: forall a. ToKeyword a => String -> a -> Header
keywordForField String
selector a
a =
  [HeaderRecord] -> Header
Header [KeywordRecord -> HeaderRecord
Keyword (KeywordRecord -> HeaderRecord) -> KeywordRecord -> HeaderRecord
forall a b. (a -> b) -> a -> b
$ Text -> a -> KeywordRecord
forall a. ToKeyword a => Text -> a -> KeywordRecord
toKeywordRecord (String -> Text
cleanKeyword String
selector) a
a]