horizon-spec-pretty (empty) → 0.0.1
raw patch · 5 files changed
+278/−0 lines, 5 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, dhall, horizon-spec, lens, path, text
Files
- ChangeLog.md +5/−0
- LICENSE +19/−0
- README.md +23/−0
- horizon-spec-pretty.cabal +53/−0
- src/Horizon/Spec/Pretty.hs +178/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for horizon-spec-pretty++## 0.0.1++* Initial import of pretty functions for `horizon-spec`.
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright 2022 Homotopic.Tech Ltd++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,23 @@+# horizon-spec-pretty++horizon-spec-pretty contains the pretty printer for+[horizon-spec](https://gitlab.homotopic.tech/horizon/horizon-spec).++The function you want is `horizonExportToExpr`.++```+Dhall.pretty $ horizonExportToExpr hz+```++## Building++```+nix build+```++## Development++```+nix develop+cabal test all+```
+ horizon-spec-pretty.cabal view
@@ -0,0 +1,53 @@+cabal-version: 3.0+name: horizon-spec-pretty+version: 0.0.1+synopsis: Horizon Stable Package Set Pretty Printer+description:+ This package contains the pretty printer for the Horizon stable package set types (https://horizon-haskell.net). This is a schema used to define package sets sourcing from hackage and git.++category: Package Management+author: Daniel Firth+maintainer: dan.firth@homotopic.tech+copyright: 2022 Daniel Firth+homepage: https://horizon-haskell.net+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://gitlab.homotopic.tech/horizon/horizon-spec-pretty++library+ exposed-modules: Horizon.Spec.Pretty+ hs-source-dirs: src+ default-extensions:+ DataKinds+ DeriveGeneric+ DerivingStrategies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ StandaloneKindSignatures+ TypeApplications+ TypeFamilies++ ghc-options:+ -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe++ build-depends:+ , base >=4.7 && <5+ , bytestring >=0.11.3 && <0.12+ , containers >=0.6.6 && <0.7+ , dhall >=1.41.2 && <1.42+ , horizon-spec >=0.6 && <0.7+ , lens >=5.0 && <5.3+ , path >=0.9.2 && <0.10+ , text >=2 && <2.1++ default-language: Haskell2010
+ src/Horizon/Spec/Pretty.hs view
@@ -0,0 +1,178 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Horizon.Spec.Pretty where++import qualified Data.ByteString as B+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.Map as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Dhall+import Dhall.Core (Binding, Chunks (Chunks),+ Directory (Directory),+ Expr (App, Embed, Field, Let, ListLit, None, RecordLit, Some, TextLit, ToMap, With),+ File (File), Import (Import),+ ImportHashed (ImportHashed),+ ImportMode (Code), ImportType (Remote),+ Scheme (HTTPS), URL (URL),+ WithComponent (WithLabel), makeBinding,+ makeFieldSelection, makeRecordField,+ pretty)+import qualified Dhall.Map as DMap+import GHC.Exts (fromList)+import Horizon.Spec (CabalFlag (MkCabalFlag),+ Compiler (MkCompiler),+ Flag (Disable, Enable),+ GitSource (MkGitSource),+ HackageSource (MkHackageSource),+ HaskellPackage (MkHaskellPackage),+ HaskellSource (FromGit, FromHackage, FromLocal, FromTarball),+ HorizonExport (MakeOverlay, MakePackageSet),+ LocalSource (MkLocalSource), Name (MkName),+ Overlay (MkOverlay),+ OverlayExportSettings (MkOverlayExportSettings),+ OverlayFile (MkOverlayFile),+ PackageList (MkPackageList),+ PackageSet (MkPackageSet),+ PackageSetExportSettings (MkPackageSetExportSettings),+ PackageSetFile (MkPackageSetFile),+ PackagesDir (MkPackagesDir), Repo (MkRepo),+ Revision (MkRevision), Subdir (MkSubdir),+ TarballSource (MkTarballSource),+ Url (MkUrl), Version (MkVersion))+import Path (Path, toFilePath)++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"++callLocalLit :: Expr s a+callLocalLit = horizonField "callLocal"++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++callLocalApp :: LocalSource -> Expr s a+callLocalApp (MkLocalSource (MkSubdir x)) = App callLocalLit $ TextLit $ Chunks [] $ T.pack . toFilePath $ x++haskellSourceToExpr :: HaskellSource -> Expr s a+haskellSourceToExpr k = case k of+ FromHackage x -> callHackageApp x+ FromGit x -> callGitApp x+ FromTarball x -> callTarballApp x+ FromLocal x -> callLocalApp 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 _ 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+horizonExportToExpr (MakeOverlay x) = overlayExportSettingsToExpr x++packageSetToExpr :: PackageSet -> Expr s a -> Expr s a+packageSetToExpr (MkPackageSet (MkCompiler c) _) xs = RecordLit $ DMap.fromList+ [ ("compiler", makeRecordField $ TextLit $ Chunks [] c)+ , ("packages", makeRecordField xs)+ ]++compilerToExpr :: Compiler -> Expr s a+compilerToExpr (MkCompiler c) = TextLit $ Chunks [] c++pathToExpr :: Path b t -> Expr s a+pathToExpr = TextLit . Chunks [] . T.pack . toFilePath++packagesDirToExpr :: PackagesDir -> Expr s a+packagesDirToExpr (MkPackagesDir d) = pathToExpr d++packageSetFileToExpr :: PackageSetFile -> Expr s a+packageSetFileToExpr (MkPackageSetFile d) = pathToExpr d++overlayFileToExpr :: OverlayFile -> Expr s a+overlayFileToExpr (MkOverlayFile d) = pathToExpr d++packageSetExportSettingsToExpr :: PackageSetExportSettings -> Expr s Import+packageSetExportSettingsToExpr (MkPackageSetExportSettings d f ys@(MkPackageSet _ xs)) = letHorizonSpecIn $ letPackagesBindingIn xs $ App (Field (horizonField "HorizonExport") (makeFieldSelection "MakePackageSet")) $ RecordLit . DMap.fromList $ [+ ("packageSetFile", makeRecordField $ packageSetFileToExpr f),+ ("packagesDir", makeRecordField $ packagesDirToExpr d),+ ("packageSet", makeRecordField $ packageSetToExpr ys $ ToMap "packages" Nothing)+ ]+++overlayExportSettingsToExpr :: OverlayExportSettings -> Expr s Import+overlayExportSettingsToExpr (MkOverlayExportSettings d f (MkOverlay ys@(MkPackageSet _ xs))) = letHorizonSpecIn $ letPackagesBindingIn xs $ App (Field (horizonField "HorizonExport") (makeFieldSelection "MakeOverlay")) $ RecordLit . DMap.fromList $ [+ ("packageSetFile", makeRecordField $ overlayFileToExpr f),+ ("packagesDir", makeRecordField $ packagesDirToExpr d),+ ("packageSet", makeRecordField $ packageSetToExpr ys $ 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)