diff --git a/horizon.dhall b/horizon.dhall
index a76552d5c1e6e6de109e8d25079ceaedef89a67a..07f7a66a49759ccd8789f7196d182d814ce83d56 100644
--- a/horizon.dhall
+++ b/horizon.dhall
@@ -1267,4 +1267,4 @@ in H.HorizonExport.MakePackageSet
{ packageSetFile = "initial-packages.nix"
, packagesDir = "pkgs/"
, packageSet = { compiler = "ghc-9.4.4", packages = toMap packages }
- }
\ No newline at end of file
+ }
diff --git a/shell/ShellRC.hs b/shell/ShellRC.hs
index 9d314a77890f42c33b63bcf9b846ffe9e5a7be16..2036d678a0a8b5a3c950170db07c0328b911355e 100644
--- a/shell/ShellRC.hs
+++ b/shell/ShellRC.hs
@@ -1,11 +1,11 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
@@ -13,8 +13,6 @@
module ShellRC where
-import Dhall.Core
-import Dhall.Src
import Brick (BrickEvent (VtyEvent), EventM,
Padding (..),
ViewportType (Vertical), Widget,
@@ -22,7 +20,6 @@ import Brick (BrickEvent (VtyEvent), EventM,
hBox, halt, on, padLeftRight, txt,
vScrollBy, viewport, viewportScroll,
visible, withAttr)
-import GHC.Exts
import qualified Brick
import Brick.Widgets.Border
import qualified Brick.Widgets.List as Brick
@@ -38,7 +35,6 @@ import qualified Data.Aeson.KeyMap as A
import qualified Data.Aeson.Lens as L
import qualified Data.ByteString as B
import Data.ByteString.Lazy.UTF8 as BLU
-import qualified Dhall.Map as DMap
import qualified Data.ByteString.Lazy.UTF8 as BU
import Data.Kind (Type)
import qualified Data.List
@@ -54,9 +50,15 @@ import qualified Data.Vector as V
import qualified Data.Yaml as Y
import qualified Data.Yaml.Pretty as Y
import qualified Dhall
+import Dhall.Core
+import qualified Dhall.Map as DMap
+import Dhall.Src
+import GHC.Exts
import Graphics.Vty.Attributes
import Graphics.Vty.Input.Events
import Horizon.Spec
+import qualified Horizon.Spec.Lens as L
+import qualified Horizon.Spec.Pretty as H
import Network.HTTP.Simple
import Path
import Polysemy
@@ -252,159 +254,9 @@ readDerivation (MkPackagesDir d) (MkName x) = do
q <- B.readFile $ toFilePath j
pure $ T.decodeUtf8Lenient q
-horizonField :: Text -> Expr s a
-horizonField = Field (horizonSpecIdentifier) . makeFieldSelection
-
-callHackageLit :: Expr s a
-callHackageLit = horizonField "callHackage"
-
-callGitLit :: Expr s a
-callGitLit = horizonField "callGit"
-
-callTarballLit :: Expr s a
-callTarballLit = horizonField "callTarball"
-
-callHackageApp :: HackageSource -> Expr s a
-callHackageApp (MkHackageSource (MkName x) (MkVersion v)) = App (App callHackageLit (TextLit $ Chunks [] x)) (TextLit $ Chunks [] v)
-
-callGitApp :: GitSource -> Expr s a
-callGitApp (MkGitSource (MkRepo (MkUrl x)) (MkRevision v) d) =
- let z = case d of
- Nothing -> App None $ horizonField "Subdir"
- Just (MkSubdir k) -> Some $ TextLit $ Chunks [] $ T.pack $ toFilePath k
- in App (App (App callGitLit (TextLit $ Chunks [] x)) (TextLit $ Chunks [] v)) z
-
-callTarballApp :: TarballSource -> Expr s a
-callTarballApp (MkTarballSource (MkUrl x)) = App callTarballLit (TextLit $ Chunks [] x)
-
-haskellSourceToExpr :: HaskellSource -> Expr s a
-haskellSourceToExpr k = case k of
- FromHackage x -> callHackageApp x
- FromGit x -> callGitApp x
- FromTarball x -> callTarballApp x
-
-cabalFlagToExpr :: CabalFlag -> Expr s a
-cabalFlagToExpr (MkCabalFlag x) =
- let (z, t) = case x of
- Disable a -> (makeFieldSelection "Disable", a)
- Enable a -> (makeFieldSelection "Enable", a)
- in App (Field (horizonField "CabalFlag") z) (TextLit $ Chunks [] t)
-
-haskellPackageToExpr :: HaskellPackage -> Expr s a
-haskellPackageToExpr (MkHaskellPackage s xs ys) =
- let t = haskellSourceToExpr s
- applyFlagsExpr = if (not . null $ ys) then \x -> With x (WithLabel "flags" :| []) (ListLit Nothing $ GHC.Exts.fromList $ map cabalFlagToExpr ys) else id
- in applyFlagsExpr t
-
-packageListToExpr :: PackageList -> Expr s a
-packageListToExpr (MkPackageList (Map.toList -> ys)) = RecordLit . DMap.fromList . map (\(MkName x, y) -> (x, makeRecordField $ haskellPackageToExpr y)) $ ys
-
-horizonExportToExpr :: HorizonExport -> Expr s Import
-horizonExportToExpr (MakePackageSet x) = packageSetExportSettingsToExpr x
-
-packageSetExportSettingsToExpr :: PackageSetExportSettings -> Expr s Import
-packageSetExportSettingsToExpr (MkPackageSetExportSettings (MkPackagesDir d) (MkPackageSetFile f) (MkPackageSet (MkCompiler c) xs)) = letHorizonSpecIn $ letPackagesBindingIn xs $ App (Field (horizonField "HorizonExport") (makeFieldSelection "MakePackageSet")) $ RecordLit . DMap.fromList $ [
- ("packageSetFile", makeRecordField $ TextLit $ Chunks [] (T.pack $ toFilePath f)),
- ("packagesDir", makeRecordField $ TextLit $ Chunks [] $ T.pack $ toFilePath d),
- ("packageSet", makeRecordField $ RecordLit $ DMap.fromList [("compiler", makeRecordField $ TextLit $ Chunks [] c), ("packages", makeRecordField $ ToMap "packages" Nothing)])]
-
-
-prettyHorizonExport :: HorizonExport -> Text
-prettyHorizonExport = Dhall.Core.pretty . horizonExportToExpr
-
-writeHorizonFile :: HorizonExport -> IO ()
-writeHorizonFile = B.writeFile "horizon.dhall" . T.encodeUtf8 . Dhall.Core.pretty . horizonExportToExpr
-
loadHorizon :: IO HorizonExport
loadHorizon = Dhall.inputFile @HorizonExport Dhall.auto "horizon.dhall"
-horizonSpecUrl :: Dhall.Core.URL
-horizonSpecUrl = Dhall.Core.URL HTTPS "gitlab.homotopic.tech" (Dhall.Core.File (Dhall.Core.Directory ["dhall", "0.6", "raw", "-", "horizon-spec", "horizon"]) "package.dhall") Nothing Nothing
-
-horizonSpecImportHashed :: ImportHashed
-horizonSpecImportHashed = ImportHashed Nothing (Remote horizonSpecUrl)
-
-horizonSpecImport :: Import
-horizonSpecImport = Import horizonSpecImportHashed Code
-
-horizonSpecIdentifier :: Expr s a
-horizonSpecIdentifier = "H"
-
-packagesIdentifier :: Text
-packagesIdentifier = "packages"
-
-horizonSpecBinding :: Binding s Import
-horizonSpecBinding = makeBinding "H" (Dhall.Core.Embed horizonSpecImport)
-
-letHorizonSpecIn :: Expr s Import -> Expr s Import
-letHorizonSpecIn = Let horizonSpecBinding
-
-packagesBinding :: PackageList -> Binding s a
-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
diff --git a/shell/default.nix b/shell/default.nix
index c1d2f165df79d7500dda1b36f0e81cfcf845bbd8..c13393b5eb4759a4670908aedc2f228732f3f410 100644
--- a/shell/default.nix
+++ b/shell/default.nix
@@ -17,6 +17,8 @@ let
http-conduit
horizon-gen-nix
horizon-spec
+ horizon-spec-lens
+ horizon-spec-pretty
lens
lens-aeson
path