-- |
-- Module      : PowerDNS.Internal.Utils
-- Description : Assorted utilities for the PowerDNS API

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module PowerDNS.Internal.Utils
  ( strip
  , Empty(..)
  , GEmpty(..)
  )
where

import           Data.List (stripPrefix)
import           GHC.Generics

-- | A variant of 'stripPrefix' that defaults to id if the prefix is not found.
strip :: Eq a => [a] -> [a] -> [a]
strip :: [a] -> [a] -> [a]
strip p :: [a]
p xs :: [a]
xs = case [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
p [a]
xs of
                  Just ys :: [a]
ys -> [a]
ys
                  Nothing -> [a]
xs


-- | Typeclass of things we can generate empty values of.
-- This is used to quickly build values from parameters to PowerDNS, because
-- you often only need a few fields.
-- @
--   empty { someField = Just 1
--         , otherField = Just "foo" }
-- @
class Empty a where
  -- | Produce an empty value
  empty :: a
  default empty :: (Generic a, GEmpty (Rep a)) => a
  empty = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) p. GEmpty f => f p
gempty

instance Empty (Maybe a) where
  empty :: Maybe a
empty = Maybe a
forall a. Maybe a
Nothing

class GEmpty f where
  gempty :: f p

instance GEmpty U1 where
  gempty :: U1 p
gempty = U1 p
forall k (p :: k). U1 p
U1

instance GEmpty f => GEmpty (M1 i t f) where
  gempty :: M1 i t f p
gempty = f p -> M1 i t f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f p
forall (f :: * -> *) p. GEmpty f => f p
gempty

instance Empty a => GEmpty (K1 i a) where
  gempty :: K1 i a p
gempty = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 a
forall a. Empty a => a
empty

instance (GEmpty f, GEmpty g) => GEmpty (f :*: g) where
  gempty :: (:*:) f g p
gempty = f p
forall (f :: * -> *) p. GEmpty f => f p
gempty f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
forall (f :: * -> *) p. GEmpty f => f p
gempty