Skip to content

Commit b0026b3

Browse files
Anton-LatukhaAnton-Latukha
authored
Merge #775: Values.hs fun code dedup, clean-up
2 parents c0b1278 + 9690927 commit b0026b3

File tree

13 files changed

+68
-77
lines changed

13 files changed

+68
-77
lines changed

‎main/Repl.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -124,9 +124,9 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
124124
| s `Data.List.isPrefixOf` x = m args
125125
| otherwise = optMatcher s xs args
126126

127-
-------------------------------------------------------------------------------
128-
-- Types
129-
-------------------------------------------------------------------------------
127+
---------------------------------------------------------------------------------
128+
-- * Types
129+
---------------------------------------------------------------------------------
130130

131131
data IState t f m = IState
132132
{ replIt :: Maybe NExprLoc -- ^ Last expression entered
@@ -171,9 +171,9 @@ initState mIni = do
171171

172172
type Repl e t f m = HaskelineT (StateT (IState t f m) m)
173173

174-
-------------------------------------------------------------------------------
175-
-- Execution
176-
-------------------------------------------------------------------------------
174+
---------------------------------------------------------------------------------
175+
-- * Execution
176+
---------------------------------------------------------------------------------
177177

178178
exec
179179
:: forall e t f m
@@ -257,9 +257,9 @@ printValue val = do
257257
| cfgValues cfg -> liftIO . print . prettyNValueProv =<< removeEffects val
258258
| otherwise -> liftIO . print . prettyNValue =<< removeEffects val
259259

260-
-------------------------------------------------------------------------------
261-
-- Commands
262-
-------------------------------------------------------------------------------
260+
---------------------------------------------------------------------------------
261+
-- * Commands
262+
---------------------------------------------------------------------------------
263263

264264
-- :browse command
265265
browse :: (MonadNix e t f m, MonadIO m)
@@ -315,9 +315,9 @@ setConfig args = case words args of
315315
[opt] -> modify (\s -> s { replCfg = helpSetOptionFunction opt (replCfg s) })
316316
_ -> liftIO $ putStrLn "No such option"
317317

318-
-------------------------------------------------------------------------------
319-
-- Interactive Shell
320-
-------------------------------------------------------------------------------
318+
---------------------------------------------------------------------------------
319+
-- * Interactive Shell
320+
---------------------------------------------------------------------------------
321321

322322
-- Prefix tab completer
323323
defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]

‎src/Nix/Atoms.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -45,9 +45,9 @@ atomText :: NAtom -> Text
4545
atomText (NURI t) = t
4646
atomText (NInt i) = pack (show i)
4747
atomText (NFloat f) = pack (showNixFloat f)
48-
where
49-
showNixFloat x
50-
| x `mod'` 1 /= 0 = show x
51-
| otherwise = show (truncate x :: Int)
48+
where
49+
showNixFloat x
50+
| x `mod'` 1 /= 0 = show x
51+
| otherwise = show (truncate x :: Int)
5252
atomText (NBool b) = if b then "true" else "false"
5353
atomText NNull = "null"

‎src/Nix/Convert.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -61,9 +61,9 @@ Do not add these instances back!
6161
6262
-}
6363

64-
{-----------------------------------------------------------------------
65-
FromValue
66-
-----------------------------------------------------------------------}
64+
---------------------------------------------------------------------------------
65+
-- * FromValue
66+
---------------------------------------------------------------------------------
6767

6868
class FromValue a m v where
6969
fromValue :: v -> m a
@@ -260,9 +260,9 @@ instance ( Convertible e t f m
260260
fromValueMay = fromValueMay . getDeeper
261261
fromValue = fromValue . getDeeper
262262

263-
{-----------------------------------------------------------------------
264-
ToValue
265-
-----------------------------------------------------------------------}
263+
---------------------------------------------------------------------------------
264+
-- * ToValue
265+
---------------------------------------------------------------------------------
266266

267267
class ToValue a m v where
268268
toValue :: a -> m v

‎src/Nix/Expr/Types.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8,14 +8,14 @@
88
{-# LANGUAGE FlexibleContexts #-}
99
{-# LANGUAGE FlexibleInstances #-}
1010
{-# LANGUAGE FunctionalDependencies #-}
11-
{-# LANGUAGE GADTs #-}
1211
{-# LANGUAGE LambdaCase #-}
1312
{-# LANGUAGE OverloadedStrings #-}
1413
{-# LANGUAGE RankNTypes #-}
1514
{-# LANGUAGE StandaloneDeriving #-}
1615
{-# LANGUAGE TemplateHaskell #-}
1716
{-# LANGUAGE TypeApplications #-}
1817
{-# LANGUAGE TypeFamilies #-}
18+
{-# LANGUAGE InstanceSigs #-}
1919

2020
{-# OPTIONS_GHC -Wno-orphans #-}
2121
{-# OPTIONS_GHC -Wno-missing-signatures #-}
@@ -27,8 +27,8 @@
2727
module Nix.Expr.Types where
2828

2929
#ifdef MIN_VERSION_serialise
30+
import qualified Codec.Serialise ( Serialise(decode, encode) ) -- For instance implementation function disamburgation
3031
import Codec.Serialise ( Serialise )
31-
import qualified Codec.Serialise as Ser
3232
#endif
3333
import Control.Applicative
3434
import Control.DeepSeq
@@ -348,12 +348,12 @@ data NKeyName r
348348
instance Serialise r => Serialise (NKeyName r)
349349

350350
instance Serialise Pos where
351-
encode x = Ser.encode (unPos x)
352-
decode = mkPos <$> Ser.decode
351+
encode x = Codec.Serialise.encode (unPos x)
352+
decode = mkPos <$> Codec.Serialise.decode
353353

354354
instance Serialise SourcePos where
355-
encode (SourcePos f l c) = Ser.encode f <> Ser.encode l <> Ser.encode c
356-
decode = SourcePos <$> Ser.decode <*> Ser.decode <*> Ser.decode
355+
encode (SourcePos f l c) = Codec.Serialise.encode f <> Codec.Serialise.encode l <> Codec.Serialise.encode c
356+
decode = SourcePos <$> Codec.Serialise.decode <*> Codec.Serialise.decode <*> Codec.Serialise.decode
357357
#endif
358358

359359
instance Hashable Pos where

‎src/Nix/Parser.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ infixl 3 <+>
9090
(<+>) :: MonadPlus m => m a -> m a -> m a
9191
(<+>) = mplus
9292

93-
--------------------------------------------------------------------------------
93+
---------------------------------------------------------------------------------
9494

9595
nixExpr :: Parser NExprLoc
9696
nixExpr = makeExprParser nixTerm $ map (map snd) (nixOperators nixSelector)

‎src/Nix/Standard.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -85,7 +85,7 @@ instance (MonadFix1T t m, MonadStore m) => MonadStore (Fix1T t m) where
8585
addPath' = lift . addPath'
8686
toFile_' n = lift . toFile_' n
8787

88-
{------------------------------------------------------------------------}
88+
---------------------------------------------------------------------------------
8989

9090
newtype StdCited m a = StdCited
9191
{ _stdCited :: Cited (StdThunk m) (StdCited m) m a }
@@ -219,7 +219,7 @@ instance (MonadInstantiate r, MonadInstantiate m) => MonadInstantiate (StandardT
219219
instance (MonadExec r, MonadExec m) => MonadExec (StandardTF r m)
220220
instance (MonadIntrospect r, MonadIntrospect m) => MonadIntrospect (StandardTF r m)
221221

222-
{------------------------------------------------------------------------}
222+
---------------------------------------------------------------------------------
223223

224224
type StandardT m = Fix1T StandardTF m
225225

‎src/Nix/Type/Env.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,9 @@ import Nix.Type.Type
2121
import Data.Foldable hiding ( toList )
2222
import qualified Data.Map as Map
2323

24-
-------------------------------------------------------------------------------
25-
-- Typing Environment
26-
-------------------------------------------------------------------------------
24+
---------------------------------------------------------------------------------
25+
-- * Typing Environment
26+
---------------------------------------------------------------------------------
2727

2828
newtype Env = TypeEnv { types :: Map.Map Name [Scheme] }
2929
deriving (Eq, Show)

‎src/Nix/Type/Infer.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -69,9 +69,9 @@ import Nix.Utils
6969
import Nix.Value.Monad
7070
import Nix.Var
7171

72-
-------------------------------------------------------------------------------
73-
-- Classes
74-
-------------------------------------------------------------------------------
72+
---------------------------------------------------------------------------------
73+
-- * Classes
74+
---------------------------------------------------------------------------------
7575

7676
-- | Inference monad
7777
newtype InferT s m a = InferT
@@ -210,9 +210,9 @@ instance Monoid InferError where
210210
mempty = TypeInferenceAborted
211211
mappend = (<>)
212212

213-
-------------------------------------------------------------------------------
214-
-- Inference
215-
-------------------------------------------------------------------------------
213+
---------------------------------------------------------------------------------
214+
-- * Inference
215+
---------------------------------------------------------------------------------
216216

217217
-- | Run the inference monad
218218
runInfer' :: MonadInfer m => InferT s m a -> m (Either InferError a)
@@ -591,9 +591,9 @@ normalizeScheme (Forall _ body) = Forall (map snd ord) (normtype body)
591591
Just x -> TVar x
592592
Nothing -> error "type variable not in signature"
593593

594-
-------------------------------------------------------------------------------
595-
-- Constraint Solver
596-
-------------------------------------------------------------------------------
594+
---------------------------------------------------------------------------------
595+
-- * Constraint Solver
596+
---------------------------------------------------------------------------------
597597

598598
newtype Solver m a = Solver (LogicT (StateT [TypeError] m) a)
599599
deriving (Functor, Applicative, Alternative, Monad, MonadPlus,

‎src/Nix/Type/Type.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@ module Nix.Type.Type where
22

33
import qualified Data.HashMap.Lazy as M
44
import Data.Text ( Text )
5-
import Nix.Utils
5+
import Nix.Utils ( AttrSet )
6+
7+
-- | Hindrey-Milner type interface
68

79
newtype TVar = TV String
810
deriving (Show, Eq, Ord)

‎src/Nix/Value.hs‎

Lines changed: 19 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,16 @@
1-
{-# LANGUAGE AllowAmbiguousTypes #-}
2-
{-# LANGUAGE ConstraintKinds #-}
3-
{-# LANGUAGE DataKinds #-}
41
{-# LANGUAGE DeriveAnyClass #-}
5-
{-# LANGUAGE DeriveDataTypeable #-}
2+
{-# LANGUAGE KindSignatures #-}
3+
{-# LANGUAGE ConstraintKinds #-}
64
{-# LANGUAGE DeriveGeneric #-}
75
{-# LANGUAGE DeriveTraversable #-}
86
{-# LANGUAGE FlexibleContexts #-}
97
{-# LANGUAGE FlexibleInstances #-}
10-
{-# LANGUAGE FunctionalDependencies #-}
11-
{-# LANGUAGE GADTs #-}
128
{-# LANGUAGE LambdaCase #-}
13-
{-# LANGUAGE OverloadedStrings #-}
149
{-# LANGUAGE PatternSynonyms #-}
1510
{-# LANGUAGE RankNTypes #-}
1611
{-# LANGUAGE ScopedTypeVariables #-}
1712
{-# LANGUAGE StandaloneDeriving #-}
1813
{-# LANGUAGE TemplateHaskell #-}
19-
{-# LANGUAGE TypeApplications #-}
20-
{-# LANGUAGE TypeFamilies #-}
21-
{-# LANGUAGE TypeOperators #-}
22-
{-# LANGUAGE UndecidableInstances #-}
2314
{-# LANGUAGE ViewPatterns #-}
2415

2516
{-# OPTIONS_GHC -Wno-missing-signatures #-}
@@ -242,12 +233,11 @@ iterNValue'
242233
-> r
243234
iterNValue' k f = f . fmap (\a -> k a (iterNValue' k f))
244235

245-
-- | An 'NValueNF' is a fully evaluated value in normal form. An 'NValue f t m' is
236+
-- | A 'NValue t f m' is
246237
-- a value in head normal form, where only the "top layer" has been
247-
-- evaluated. An action of type 'm (NValue f t m)' is a pending evaluation that
238+
-- evaluated. An action of type 'm (NValue t f m)' is a pending evaluation that
248239
-- has yet to be performed. An 't' is either a pending evaluation, or
249-
-- a value in head normal form. A 'NThunkSet' is a set of mappings from keys
250-
-- to thunks.
240+
-- a value in head normal form.
251241
--
252242
-- The 'Free' structure is used here to represent the possibility that
253243
-- cycles may appear during normalization.
@@ -307,64 +297,63 @@ pattern NVConstant' x <- NValue (extract -> NVConstantF x)
307297
pattern NVConstant x <- Free (NVConstant' x)
308298

309299
nvConstant' :: Applicative f => NAtom -> NValue' t f m r
310-
nvConstant' x = NValue (pure (NVConstantF x))
300+
nvConstant' = NValue . pure . NVConstantF
311301
nvConstant :: Applicative f => NAtom -> NValue t f m
312-
nvConstant x = Free (NValue (pure (NVConstantF x)))
302+
nvConstant = Free . nvConstant'
313303

314304
pattern NVStr' ns <- NValue (extract -> NVStrF ns)
315305
pattern NVStr ns <- Free (NVStr' ns)
316306

317307
nvStr' :: Applicative f => NixString -> NValue' t f m r
318-
nvStr' ns = NValue (pure (NVStrF ns))
308+
nvStr' = NValue . pure . NVStrF
319309
nvStr :: Applicative f => NixString -> NValue t f m
320-
nvStr ns = Free (NValue (pure (NVStrF ns)))
310+
nvStr = Free . nvStr'
321311

322312
pattern NVPath' x <- NValue (extract -> NVPathF x)
323313
pattern NVPath x <- Free (NVPath' x)
324314

325315
nvPath' :: Applicative f => FilePath -> NValue' t f m r
326-
nvPath' x = NValue (pure (NVPathF x))
316+
nvPath' = NValue . pure . NVPathF
327317
nvPath :: Applicative f => FilePath -> NValue t f m
328-
nvPath x = Free (NValue (pure (NVPathF x)))
318+
nvPath = Free . nvPath'
329319

330320
pattern NVList' l <- NValue (extract -> NVListF l)
331321
pattern NVList l <- Free (NVList' l)
332322

333323
nvList' :: Applicative f => [r] -> NValue' t f m r
334-
nvList' l = NValue (pure (NVListF l))
324+
nvList' = NValue . pure . NVListF
335325
nvList :: Applicative f => [NValue t f m] -> NValue t f m
336-
nvList l = Free (NValue (pure (NVListF l)))
326+
nvList = Free . nvList'
337327

338328
pattern NVSet' s x <- NValue (extract -> NVSetF s x)
339329
pattern NVSet s x <- Free (NVSet' s x)
340330

341331
nvSet' :: Applicative f
342332
=> HashMap Text r -> HashMap Text SourcePos -> NValue' t f m r
343-
nvSet' s x = NValue (pure (NVSetF s x))
333+
nvSet' s x = NValue $ pure $ NVSetF s x
344334
nvSet :: Applicative f
345335
=> HashMap Text (NValue t f m) -> HashMap Text SourcePos -> NValue t f m
346-
nvSet s x = Free (NValue (pure (NVSetF s x)))
336+
nvSet s x = Free $ nvSet' s x
347337

348338
pattern NVClosure' x f <- NValue (extract -> NVClosureF x f)
349339
pattern NVClosure x f <- Free (NVClosure' x f)
350340

351341
nvClosure' :: (Applicative f, Functor m)
352342
=> Params () -> (NValue t f m -> m r) -> NValue' t f m r
353-
nvClosure' x f = NValue (pure (NVClosureF x f))
343+
nvClosure' x f = NValue $ pure $ NVClosureF x f
354344
nvClosure :: (Applicative f, Functor m)
355345
=> Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
356-
nvClosure x f = Free (NValue (pure (NVClosureF x f)))
346+
nvClosure x f = Free $ nvClosure' x f
357347

358348
pattern NVBuiltin' name f <- NValue (extract -> NVBuiltinF name f)
359349
pattern NVBuiltin name f <- Free (NVBuiltin' name f)
360350

361351
nvBuiltin' :: (Applicative f, Functor m)
362352
=> String -> (NValue t f m -> m r) -> NValue' t f m r
363-
nvBuiltin' name f = NValue (pure (NVBuiltinF name f))
353+
nvBuiltin' name f = NValue $ pure $ NVBuiltinF name f
364354
nvBuiltin :: (Applicative f, Functor m)
365355
=> String -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
366-
nvBuiltin name f =
367-
Free (NValue (pure (NVBuiltinF name f)))
356+
nvBuiltin name f = Free $ nvBuiltin' name f
368357

369358
builtin
370359
:: forall m f t

0 commit comments

Comments
 (0)