Add Show1 instances for base 4.9

This commit is contained in:
Joe Hermaszewski 2016-09-21 10:31:31 +01:00
parent e2b80391bb
commit d3651984fb
6 changed files with 51 additions and 14 deletions

View File

@ -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 f (DynamicKey (Plain str)) = DynamicKey . Plain $ fmap f str
@ -216,3 +244,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)

View File

@ -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)

View File

@ -1,4 +1,4 @@
{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7102" }:
{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc801" }:
let
haskellPackages = nixpkgs.pkgs.haskell.packages.${compiler};
in

View File

@ -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

View File

@ -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

View File

@ -1,2 +1,2 @@
{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc7103" }:
{ nixpkgs ? import <nixpkgs> {}, compiler ? "ghc801" }:
(import ./default.nix { inherit nixpkgs compiler; }).env