{-# OPTIONS_GHC -fno-warn-orphans #-} module Horizon.Spec.Lens (HasPackageSet, HasPackages) where import Control.Lens as L (At, Index, IxValue, Ixed, Lens', at, ix, lens) import Data.Kind (Constraint, Type) import Horizon.Spec (HaskellPackage, HorizonExport (MakeOverlay, MakePackageSet), Name, Overlay (MkOverlay), OverlayExportSettings, PackageList (MkPackageList), PackageSet, PackageSetExportSettings, fromOverlay, overlay, packageSet, packages) type HasPackageSet :: Type -> Constraint class HasPackageSet x where packageSetL :: L.Lens' x PackageSet instance HasPackageSet Overlay where packageSetL = L.lens fromOverlay (\(MkOverlay _) ys -> MkOverlay ys) instance HasPackageSet PackageSetExportSettings where packageSetL = L.lens packageSet (\x y -> x { packageSet = y }) instance HasPackageSet OverlayExportSettings where packageSetL = L.lens overlay (\x y -> x { overlay = y }) . packageSetL @Overlay instance HasPackageSet HorizonExport where packageSetL f = \case MakePackageSet x -> MakePackageSet <$> packageSetL f x MakeOverlay x -> MakeOverlay <$> packageSetL f x type HasPackages :: Type -> Constraint class HasPackages x where packagesL :: L.Lens' x PackageList instance HasPackages PackageSet where packagesL = L.lens packages (\x y -> x { packages = y }) instance HasPackages HorizonExport where packagesL = packageSetL . packagesL @PackageSet type instance L.IxValue PackageList = HaskellPackage type instance L.Index PackageList = Name type instance L.IxValue HorizonExport = HaskellPackage type instance L.Index HorizonExport = Name instance L.Ixed PackageList where ix k f (MkPackageList xs) = MkPackageList <$> L.ix k f xs instance L.At PackageList where at k f (MkPackageList xs) = MkPackageList <$> L.at k f xs instance L.Ixed HorizonExport where ix k = packagesL @HorizonExport . L.ix @PackageList k instance L.At HorizonExport where at k = packagesL @HorizonExport . L.at @PackageList k