module Hix.Class.EncodeNix where

import qualified Data.Map.Strict as Map
import Distribution.Pretty (Pretty (pretty))
import Distribution.Utils.ShortText (ShortText, fromShortText)
import Distribution.Version (Version, VersionRange, simplifyVersionRange)
import Generics.SOP (All2, K (K), SListI2, hcmap, hcollapse)
import Text.PrettyPrint (Doc)

import Hix.Class.SOP (Field (Field), FieldK (FieldK), ToFields (toFields))
import Hix.Data.NixExpr (Expr (..), ExprAttr (ExprAttr), ViaPretty (ViaPretty), exprBool, exprShow)

type EncodeField :: FieldK -> Constraint
class EncodeField field where
  encodeField :: Field field -> ExprAttr

instance (
    KnownSymbol name,
    EncodeNix a
  ) => EncodeField ('FieldK name a) where
    encodeField :: Field ('FieldK name a) -> ExprAttr
encodeField (Field a
a) =
      Text -> Expr -> ExprAttr
ExprAttr (String -> Text
forall a. ToText a => a -> Text
toText (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name))) (a -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix a
a)

class EncodeProd a where
  encodeProd :: a -> Expr

instance (
    ToFields a fields,
    All2 EncodeField fields,
    SListI2 fields
  ) => EncodeProd a where
    encodeProd :: a -> Expr
encodeProd =
      [ExprAttr] -> Expr
ExprAttrs ([ExprAttr] -> Expr) -> (a -> [ExprAttr]) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      SOP (K ExprAttr) fields -> [ExprAttr]
SOP (K ExprAttr) fields -> CollapseTo SOP ExprAttr
forall (xs :: [[FieldK]]) a.
SListIN SOP xs =>
SOP (K a) xs -> CollapseTo SOP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (SOP (K ExprAttr) fields -> [ExprAttr])
-> (a -> SOP (K ExprAttr) fields) -> a -> [ExprAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Proxy EncodeField
-> (forall (a :: FieldK). EncodeField a => Field a -> K ExprAttr a)
-> SOP Field fields
-> SOP (K ExprAttr) fields
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall (t :: FieldK -> Constraint). Proxy t
Proxy @EncodeField) (ExprAttr -> K ExprAttr a
forall k a (b :: k). a -> K a b
K (ExprAttr -> K ExprAttr a)
-> (Field a -> ExprAttr) -> Field a -> K ExprAttr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field a -> ExprAttr
forall (field :: FieldK).
EncodeField field =>
Field field -> ExprAttr
encodeField) (SOP Field fields -> SOP (K ExprAttr) fields)
-> (a -> SOP Field fields) -> a -> SOP (K ExprAttr) fields
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      a -> SOP Field fields
forall a (fields :: [[FieldK]]).
ToFields a fields =>
a -> SOP Field fields
toFields

class EncodeNixKey a where
  encodeNixKey :: a -> Text

instance EncodeNixKey Text where
  encodeNixKey :: Text -> Text
encodeNixKey = Text -> Text
forall a. a -> a
id

class EncodeNix a where
  encodeNix :: a -> Expr
  default encodeNix :: EncodeProd a => a -> Expr
  encodeNix = a -> Expr
forall a. EncodeProd a => a -> Expr
encodeProd

instance EncodeNix Expr where
  encodeNix :: Expr -> Expr
encodeNix = Expr -> Expr
forall a. a -> a
id

instance EncodeNix Bool where
  encodeNix :: Bool -> Expr
encodeNix = Bool -> Expr
exprBool

instance EncodeNix Int where
  encodeNix :: Int -> Expr
encodeNix = Int -> Expr
forall a. Show a => a -> Expr
exprShow

instance EncodeNix Version where
  encodeNix :: Version -> Expr
encodeNix = Doc -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix (Doc -> Expr) -> (Version -> Doc) -> Version -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Doc
forall a. Pretty a => a -> Doc
pretty

instance EncodeNix VersionRange where
  encodeNix :: VersionRange -> Expr
encodeNix = Doc -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix (Doc -> Expr) -> (VersionRange -> Doc) -> VersionRange -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Doc
forall a. Pretty a => a -> Doc
pretty (VersionRange -> Doc)
-> (VersionRange -> VersionRange) -> VersionRange -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> VersionRange
simplifyVersionRange

instance EncodeNix a => EncodeNix (Maybe a) where
  encodeNix :: Maybe a -> Expr
encodeNix = \case
    Just a
a -> a -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix a
a
    Maybe a
Nothing -> Expr
ExprNull

instance EncodeNix a => EncodeNix [a] where
  encodeNix :: [a] -> Expr
encodeNix = [Expr] -> Expr
ExprList ([Expr] -> Expr) -> ([a] -> [Expr]) -> [a] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Expr) -> [a] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix

instance EncodeNix a => EncodeNix (NonEmpty a) where
  encodeNix :: NonEmpty a -> Expr
encodeNix = [Expr] -> Expr
ExprList ([Expr] -> Expr) -> (NonEmpty a -> [Expr]) -> NonEmpty a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Expr -> [Expr]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Expr -> [Expr])
-> (NonEmpty a -> NonEmpty Expr) -> NonEmpty a -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Expr) -> NonEmpty a -> NonEmpty Expr
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix

instance (
    EncodeNixKey k,
    EncodeNix v
  ) => EncodeNix (Map k v) where
    encodeNix :: Map k v -> Expr
encodeNix = [ExprAttr] -> Expr
ExprAttrs ([ExprAttr] -> Expr) -> (Map k v -> [ExprAttr]) -> Map k v -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> ExprAttr) -> [(k, v)] -> [ExprAttr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Expr -> ExprAttr) -> (Text, Expr) -> ExprAttr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expr -> ExprAttr
ExprAttr ((Text, Expr) -> ExprAttr)
-> ((k, v) -> (Text, Expr)) -> (k, v) -> ExprAttr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Text) -> (v -> Expr) -> (k, v) -> (Text, Expr)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> Text
forall a. EncodeNixKey a => a -> Text
encodeNixKey v -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix) ([(k, v)] -> [ExprAttr])
-> (Map k v -> [(k, v)]) -> Map k v -> [ExprAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList

instance EncodeNix Doc where
  encodeNix :: Doc -> Expr
encodeNix = Text -> Expr
ExprString (Text -> Expr) -> (Doc -> Text) -> Doc -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall b a. (Show a, IsString b) => a -> b
show

instance EncodeNix Text where
  encodeNix :: Text -> Expr
encodeNix = Text -> Expr
ExprString

instance EncodeNix ShortText where
  encodeNix :: ShortText -> Expr
encodeNix = Text -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix (Text -> Expr) -> (ShortText -> Text) -> ShortText -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (ShortText -> String) -> ShortText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
fromShortText

instance Pretty a => EncodeNix (ViaPretty a) where
  encodeNix :: ViaPretty a -> Expr
encodeNix (ViaPretty a
a) = Doc -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a)