{-# OPTIONS_GHC -Wno-orphans #-}

module Iri.Data.Instances.Lift where

import qualified Data.WideWord.Word128
import Iri.Data.Types
import Iri.Prelude
import Language.Haskell.TH.Lift
import Language.Haskell.TH.Syntax
import qualified Net.IPv6

fmap concat
  $ traverse deriveLift
  $ [ ''RegName,
      ''DomainLabel
    ]

instance Lift Host where
  lift :: forall (m :: * -> *). Quote m => Host -> m Exp
lift = \case
    NamedHost RegName
regName ->
      Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'NamedHost) (Exp -> Exp) -> m Exp -> m Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegName -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => RegName -> m Exp
lift RegName
regName
    IpV4Host IPv4
ipV4 ->
      Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'IpV4Host) (Exp -> Exp) -> m Exp -> m Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> $(makeLift ''IPv4) IPv4
ipV4
    IpV6Host (Net.IPv6.IPv6 Word128
word128) -> do
      Exp
word128Exp <- $(makeLift ''Data.WideWord.Word128.Word128) Word128
word128
      Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'IpV6Host) (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'Net.IPv6.IPv6) Exp
word128Exp))

  liftTyped :: forall (m :: * -> *). Quote m => Host -> Code m Host
liftTyped =
    m (TExp Host) -> Code m Host
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (m (TExp Host) -> Code m Host)
-> (Host -> m (TExp Host)) -> Host -> Code m Host
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Exp -> TExp Host) -> m Exp -> m (TExp Host)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp Host
forall a. Exp -> TExp a
TExp (m Exp -> m (TExp Host))
-> (Host -> m Exp) -> Host -> m (TExp Host)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Host -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Host -> m Exp
lift

fmap concat
  $ traverse deriveLift
  $ [ ''Authority,
      ''Fragment,
      ''Hierarchy,
      ''HttpIri,
      ''Iri,
      ''Password,
      ''Path,
      ''PathSegment,
      ''Port,
      ''Query,
      ''Scheme,
      ''Security,
      ''User,
      ''UserInfo
    ]