From 80c0a484373e6d95079cb674f13d15b9ce5d04c6 Mon Sep 17 00:00:00 2001
From: Daniel Firth <dan.firth@homotopic.tech>
Date: Thu, 23 Feb 2023 11:01:06 +0000
Subject: [PATCH] ShellRC: add some lenses
---
shell/ShellRC.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 62 insertions(+)
diff --git a/shell/ShellRC.hs b/shell/ShellRC.hs
index 94b03685..9d314a77 100644
--- a/shell/ShellRC.hs
+++ b/shell/ShellRC.hs
@@ -1,9 +1,11 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
@@ -343,6 +345,66 @@ packagesBinding = makeBinding packagesIdentifier . packageListToExpr
letPackagesBindingIn :: PackageList -> Expr s a -> Expr s a
letPackagesBindingIn xs = Let (packagesBinding xs)
+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
+
+
+deriving newtype instance IsString Name
+
+deriving newtype instance IsString Version
+
+defaultModifiers :: Modifiers
+defaultModifiers = MkModifiers True True False False False
+
+callHackage :: Name -> Version -> HaskellPackage
+callHackage n v = MkHaskellPackage { source = FromHackage n v, flags = [], modifiers = defaultModifiers }
+
go :: IO ()
go = do
x <- loadHorizon
--
GitLab