diff --git a/Nix/Expr/Types.hs b/Nix/Expr/Types.hs index 64202aa..21de6c3 100644 --- a/Nix/Expr/Types.hs +++ b/Nix/Expr/Types.hs @@ -6,6 +6,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} -- | The nix expression type and supporting types. module Nix.Expr.Types where @@ -13,8 +14,8 @@ import Control.Monad hiding (forM_, mapM, sequence) import Data.Data import Data.Fix import Data.Foldable -import Data.Functor.Classes (Show1(..)) -import Data.Map (Map) +import Data.Functor.Classes (Show1(..), showsUnaryWith, liftShowsPrec2) +import Data.Map (Map, toList) import Data.Text (Text, pack) import Data.Traversable import GHC.Exts @@ -22,6 +23,7 @@ import GHC.Generics import Nix.Atoms import Prelude hiding (readFile, concat, concatMap, elem, mapM, sequence, minimum, foldr) +import Text.Show.Deriving -- | The main nix expression type. This is polymorphic so that it can be made -- a functor, which allows us to traverse expressions and map functions over @@ -72,14 +74,12 @@ data NExprF r -- ^ Assert that the first returns true before evaluating the second. deriving (Ord, Eq, Generic, Typeable, Data, Functor, Foldable, Traversable, Show) -instance Show1 NExprF where - showsPrec1 = showsPrec - -- | We make an `IsString` for expressions, where the string is interpreted -- as an identifier. This is the most common use-case... instance IsString NExpr where fromString = Fix . NSym . fromString + -- | The monomorphic expression type is a fixed point of the polymorphic one. type NExpr = Fix NExprF @@ -116,6 +116,27 @@ data ParamSet r deriving (Ord, Eq, Generic, Typeable, Data, Functor, Show, Foldable, Traversable) +-- It's not possible to derive this automatically as there is no Show1 instance +-- for Map. We define one locally here. +instance Show1 ParamSet where + liftShowsPrec sp sl p = + let liftShowsPrecMap :: (Int -> a -> ShowS) + -> ([a] -> ShowS) + -> Int + -> Map Text a + -> ShowS + liftShowsPrecMap spMap slMap pMap m = + showsUnaryWith (liftShowsPrec (liftShowsPrec spMap slMap) + (liftShowList spMap slMap)) + "fromList" pMap (Data.Map.toList m) + showNamedMap s = + showsUnaryWith (liftShowsPrecMap (liftShowsPrec sp sl) + (liftShowList sp sl)) + s p + in \case + FixedParamSet m -> showNamedMap "FixedParamSet" m + VariadicParamSet m -> showNamedMap "VariadicParamSet" m + -- | 'Antiquoted' represents an expression that is either -- antiquoted (surrounded by ${...}) or plain (not antiquoted). data Antiquoted v r = Plain !v | Antiquoted !r @@ -166,7 +187,14 @@ data NKeyName r instance IsString (NKeyName r) where fromString = StaticKey . fromString --- | Deriving this instance automatically is not possible because @r@ +-- Deriving this instance automatically is not possible because @r@ +-- occurs not only as last argument in @Antiquoted (NString r) r@ +instance Show1 NKeyName where + liftShowsPrec sp sl p = \case + DynamicKey a -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl) "DynamicKey" p a + StaticKey t -> showsUnaryWith showsPrec "StaticKey" p t + +-- Deriving this instance automatically is not possible because @r@ -- occurs not only as last argument in @Antiquoted (NString r) r@ instance Functor NKeyName where fmap = fmapDefault @@ -215,3 +243,10 @@ data NBinaryOp paramName :: Params r -> Maybe Text paramName (Param n) = Just n paramName (ParamSet _ n) = n + +$(deriveShow1 ''NExprF) +$(deriveShow1 ''NString) +$(deriveShow1 ''Params) +$(deriveShow1 ''Binding) +$(deriveShow1 ''Antiquoted) +$(deriveShow2 ''Antiquoted) diff --git a/Nix/Expr/Types/Annotated.hs b/Nix/Expr/Types/Annotated.hs index 14fa6fe..872866e 100644 --- a/Nix/Expr/Types/Annotated.hs +++ b/Nix/Expr/Types/Annotated.hs @@ -7,6 +7,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + -- | The source location annotated nix expression type and supporting types. -- module Nix.Expr.Types.Annotated @@ -18,7 +20,6 @@ import Control.Monad hiding (forM_, mapM, sequence) import Data.Data import Data.Fix import Data.Function (on) -import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose import Data.Semigroup import GHC.Generics @@ -26,6 +27,7 @@ import Nix.Expr.Types import Nix.Parser.Library (Delta(..)) import Prelude hiding (concat, concatMap, elem, foldr, mapM, minimum, readFile, sequence) +import Text.Show.Deriving -- | A location in a source file data SrcSpan = SrcSpan{ spanBegin :: Delta @@ -42,8 +44,7 @@ data Ann ann a = Ann{ annotation :: ann } deriving (Ord, Eq, Data, Generic, Typeable, Functor, Foldable, Traversable, Read, Show) -instance Show ann => Show1 (Ann ann) where - showsPrec1 = showsPrec +$(deriveShow1 ''Ann) instance Semigroup SrcSpan where s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2) diff --git a/default.nix b/default.nix index 70ae4ed..9a52cb1 100644 --- a/default.nix +++ b/default.nix @@ -1,4 +1,4 @@ -{ nixpkgs ? import {}, compiler ? "ghc7102" }: +{ nixpkgs ? import {}, compiler ? "ghc801" }: let haskellPackages = nixpkgs.pkgs.haskell.packages.${compiler}; in diff --git a/hnix.cabal b/hnix.cabal index a895ec0..1d78320 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -51,9 +51,10 @@ Library RankNTypes TupleSections Build-depends: - base >= 4.6 && < 5 + base >= 4.9 && < 5 , ansi-wl-pprint , containers + , deriving-compat >= 0.3 && < 0.4 , text , transformers , parsers >= 0.10 diff --git a/project.nix b/project.nix index b771e92..81949e5 100644 --- a/project.nix +++ b/project.nix @@ -1,6 +1,6 @@ { mkDerivation, ansi-wl-pprint, base, containers, data-fix, deepseq , parsers, stdenv, tasty, tasty-hunit, tasty-th, text, transformers -, trifecta, unordered-containers, cabal-install, criterion, pkgs +, trifecta, unordered-containers, criterion, pkgs, deriving-compat }: let @@ -18,7 +18,7 @@ mkDerivation { isExecutable = true; libraryHaskellDepends = [ ansi-wl-pprint base containers data-fix deepseq parsers text - transformers trifecta unordered-containers cabal-install criterion + transformers trifecta unordered-containers criterion deriving-compat ]; executableHaskellDepends = [ ansi-wl-pprint base containers data-fix deepseq diff --git a/shell.nix b/shell.nix index 8a628df..029cc03 100644 --- a/shell.nix +++ b/shell.nix @@ -1,2 +1,2 @@ -{ nixpkgs ? import {}, compiler ? "ghc7103" }: +{ nixpkgs ? import {}, compiler ? "ghc801" }: (import ./default.nix { inherit nixpkgs compiler; }).env