Skip to content

Commit

Permalink
treewide: (Expr.Types.VarName -> newtype) lift-up type boundary
Browse files Browse the repository at this point in the history
This is obviously a big change.

Before this units of data in expressions were undistinquisable from Text.

Not VarName is there to mark something as an abstraction, some argument that
has/can have/can be binded a value.

Went through the whole project & established the boundary.

The boundary stops entering the Derivations (their file format puts everything
in "", so they are left as text), CLI Options & Executable.

Maybe `KeyMap` datatype that is in utils should be removed, at least the
`Keymap SourcePos` should be replaced with `PosSet`.

Now the code would be more intuitive & would read better.
  • Loading branch information
Anton-Latukha committed Jul 16, 2021
1 parent 5f096dd commit a65d6bb
Show file tree
Hide file tree
Showing 27 changed files with 259 additions and 208 deletions.
6 changes: 3 additions & 3 deletions main/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -126,8 +126,8 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
expr' <- liftIO $ reduceExpr mpath expr
either
(\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <> ppShow
(fromJust $ Map.lookup "it" (coerce ty :: Map Text [Scheme]))
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <>
ppShow (fromJust $ Map.lookup @VarName @[Scheme] "it" (coerce ty))
)
(HM.inferTop mempty [("it", stripAnnotation expr')])

Expand Down Expand Up @@ -234,7 +234,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
(pure . pure . Free)
nv
)
(sortWith fst $ M.toList s)
(sortWith fst $ M.toList $ M.mapKeys coerce s)
traverse_
(\ (k, mv) ->
do
Expand Down
23 changes: 14 additions & 9 deletions main/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -281,11 +281,16 @@ printValue val = do
browse :: (MonadNix e t f m, MonadIO m)
=> Text
-> Repl e t f m ()
browse _ = do
st <- get
for_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do
liftIO $ Text.putStr $ k <> " = "
printValue v
browse _ =
do
st <- get
traverse_
(\(k, v) ->
do
liftIO $ Text.putStr $ coerce k <> " = "
printValue v
)
(Data.HashMap.Lazy.toList $ replCtx st)

-- | @:load@ command
load
Expand Down Expand Up @@ -313,7 +318,7 @@ typeof args = do
maybe
(exec False line)
(pure . pure)
(Data.HashMap.Lazy.lookup line (replCtx st))
(Data.HashMap.Lazy.lookup (coerce line) (replCtx st))

traverse_ printValueType mVal

Expand Down Expand Up @@ -398,7 +403,7 @@ completeFunc reversedPrev word
candidates
)
)
(Data.HashMap.Lazy.lookup var (replCtx s))
(Data.HashMap.Lazy.lookup (coerce var) (replCtx s))

-- Builtins, context variables
| otherwise =
Expand Down Expand Up @@ -439,10 +444,10 @@ completeFunc reversedPrev word
(("." <> f) <>)
. algebraicComplete fs <=< demand
)
(Data.HashMap.Lazy.lookup f m)
(Data.HashMap.Lazy.lookup (coerce f) m)
in
case val of
NVSet xs _ -> withMap xs
NVSet xs _ -> withMap (Data.HashMap.Lazy.mapKeys coerce xs)
_ -> stub

-- | HelpOption inspired by Dhall Repl
Expand Down
14 changes: 7 additions & 7 deletions src/Nix.hs
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ evaluateExpression
evaluateExpression mpath evaluator handler expr =
do
opts :: Options <- asks $ view hasLens
args <-
(coerce -> args) <-
(traverse . traverse)
eval'
$ (second parseArg <$> arg opts)
Expand Down Expand Up @@ -137,23 +137,23 @@ processResult h val = do
opts :: Options <- asks $ view hasLens
maybe
(h val)
(\ (Text.splitOn "." -> keys) -> processKeys keys val)
(\ (coerce . Text.splitOn "." -> keys) -> processKeys keys val)
(attr opts)
where
processKeys :: [Text] -> NValue t f m -> m a
processKeys :: [VarName] -> NValue t f m -> m a
processKeys kys v =
list
(h v)
(\ (k : ks) ->
(\ ((k : ks) :: [VarName]) ->
do
v' <- demand v
case (k, v') of
(Text.decimal -> Right (n,""), NVList xs) -> processKeys ks $ xs !! n
(Text.decimal . coerce -> Right (n,""), NVList xs) -> processKeys ks $ xs !! n
(_, NVSet xs _) ->
maybe
(errorWithoutStackTrace $ toString $ "Set does not contain key '" <> k <> "'")
(errorWithoutStackTrace $ "Set does not contain key ''" <> show k <> "''.")
(processKeys ks)
(M.lookup k xs)
(_, _) -> errorWithoutStackTrace $ toString $ "Expected a set or list for selector '" <> k <> "', but got: " <> show v
(_, _) -> errorWithoutStackTrace $ "Expected a set or list for selector '" <> show k <> "', but got: " <> show v
)
kys
76 changes: 42 additions & 34 deletions src/Nix/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,7 @@ data BuiltinType = Normal | TopLevel
data Builtin v =
Builtin
{ _kind :: BuiltinType
, mapping :: (Text, v)
, mapping :: (VarName, v)
}

-- *** @class ToBuiltin@ and its instances
Expand All @@ -124,7 +124,7 @@ instance
)
=> ToBuiltin t f m (a -> b) where
toBuiltin name f =
pure $ nvBuiltin name $ toBuiltin name . f <=< fromValue . Deeper
pure $ nvBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper

-- *** @WValue@ closure wrapper to have @Ord@

Expand Down Expand Up @@ -213,10 +213,10 @@ foldNixPath z f =
[n, p] -> f (toString p) (pure n) ty rest
_ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " <> show x

attrsetGet :: MonadNix e t f m => Text -> AttrSet (NValue t f m) -> m (NValue t f m)
attrsetGet :: MonadNix e t f m => VarName -> AttrSet (NValue t f m) -> m (NValue t f m)
attrsetGet k s =
maybe
(throwError $ ErrorCall $ "Attribute '" <> toString k <> "' required")
(throwError $ ErrorCall $ toString @Text $ "Attribute '" <> coerce k <> "' required")
pure
(M.lookup k s)

Expand Down Expand Up @@ -440,8 +440,8 @@ hasAttrNix
-> m (NValue t f m)
hasAttrNix x y =
do
key <- fromStringNoContext =<< fromValue x
(aset, _) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) y
(coerce -> key) <- fromStringNoContext =<< fromValue x
(aset, _) <- fromValue @(AttrSet (NValue t f m), KeyMap SourcePos) y

toValue $ M.member key aset

Expand All @@ -456,8 +456,8 @@ getAttrNix
-> m (NValue t f m)
getAttrNix x y =
do
key <- fromStringNoContext =<< fromValue x
(aset, _) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) y
(coerce -> key) <- fromStringNoContext =<< fromValue x
(aset, _) <- fromValue @(AttrSet (NValue t f m), KeyMap SourcePos) y

attrsetGet key aset

Expand Down Expand Up @@ -633,7 +633,7 @@ parseDrvNameNix drvname =

toValue @(AttrSet (NValue t f m)) $
M.fromList
[ ( "name" :: Text
[ ( "name" :: VarName
, mkNVStr name
)
, ( "version"
Expand Down Expand Up @@ -720,7 +720,7 @@ substringNix start len str =
attrNamesNix
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
attrNamesNix =
(fmap (coerce :: CoerceDeeperToNValue t f m) . toValue . fmap makeNixStringWithoutContext . sort . M.keys)
(fmap (coerce :: CoerceDeeperToNValue t f m) . toValue . fmap (makeNixStringWithoutContext . coerce @VarName @Text) . sort . M.keys)
<=< fromValue @(AttrSet (NValue t f m))

attrValuesNix
Expand All @@ -731,7 +731,7 @@ attrValuesNix nvattrs =
toValue $
snd <$>
sortOn
(fst @Text @(NValue t f m))
(fst @VarName @(NValue t f m))
(M.toList attrs)

mapNix
Expand Down Expand Up @@ -764,7 +764,7 @@ mapAttrsNix f xs =

applyFunToKeyVal (key, val) =
do
runFunForKey <- callFunc f $ nvStrWithoutContext key
runFunForKey <- callFunc f $ nvStrWithoutContext (coerce key)
callFunc runFunForKey val

newVals <-
Expand Down Expand Up @@ -799,7 +799,7 @@ catAttrsNix attrName xs =

nvList . catMaybes <$>
traverse
(fmap (M.lookup n) . fromValue <=< demand)
(fmap (M.lookup (coerce @Text @VarName n)) . fromValue <=< demand)
l

baseNameOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
Expand Down Expand Up @@ -1074,11 +1074,12 @@ removeAttrsNix
-> m (NValue t f m)
removeAttrsNix set v =
do
(m, p) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set
(m, p) <- fromValue @(AttrSet (NValue t f m), KeyMap SourcePos) set
(nsToRemove :: [NixString]) <- fromValue $ Deeper v
toRemove <- traverse fromStringNoContext nsToRemove
toValue (go m toRemove, go p toRemove)
toRemove <- traverse (fmap (coerce @Text @VarName) . fromStringNoContext) nsToRemove
toValue (go @VarName m toRemove, go @Text p (coerce @VarName <$> toRemove))
where
go :: forall k v . (Eq k, Hashable k) => HashMap k v -> [k] -> HashMap k v
go = foldl' (flip M.delete)

intersectAttrsNix
Expand All @@ -1089,8 +1090,8 @@ intersectAttrsNix
-> m (NValue t f m)
intersectAttrsNix set1 set2 =
do
(s1, p1) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set1
(s2, p2) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set2
(s1, p1) <- fromValue @(AttrSet (NValue t f m), KeyMap SourcePos) set1
(s2, p2) <- fromValue @(AttrSet (NValue t f m), KeyMap SourcePos) set2

pure $ nvSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)

Expand Down Expand Up @@ -1122,7 +1123,7 @@ toFileNix name s =
(stringIgnoreContext s')

let
t = toText @FilePath $ coerce mres
t = coerce $ toText @FilePath $ coerce mres
sc = StringContext t DirectPath

toValue $ makeNixStringWithSingletonContext t sc
Expand Down Expand Up @@ -1371,7 +1372,7 @@ listToAttrsNix lst =
(\ nvattrset ->
do
a <- fromValue @(AttrSet (NValue t f m)) =<< demand nvattrset
name <- fromStringNoContext =<< fromValue =<< demand =<< attrsetGet "name" a
(coerce -> name) <- fromStringNoContext =<< fromValue =<< demand =<< attrsetGet "name" a
val <- attrsetGet "value" a

pure (name, val)
Expand Down Expand Up @@ -1480,7 +1481,7 @@ readDirNix nvpath =
| isSymbolicLink s -> FileTypeSymlink
| otherwise -> FileTypeUnknown

pure (toText item, t)
pure (coerce @Text @VarName $ toText item, t) -- function indeed binds filepaths as keys (VarNames) in Nix attrset.

itemsWithTypes <-
traverse
Expand All @@ -1503,8 +1504,10 @@ fromJSONNix nvjson =
(A.eitherDecodeStrict' @A.Value $ encodeUtf8 jText)

where
-- jsonToNValue :: MonadNix e t f m => A.Value -> f (NValue t f m)
jsonToNValue :: (A.Value -> m (NValue t f m))
jsonToNValue = \case
A.Object m -> nvSet mempty <$> traverse jsonToNValue m
A.Object m -> nvSet mempty <$> traverse jsonToNValue (M.mapKeys coerce m)
A.Array l -> nvList <$> traverse jsonToNValue (V.toList l)
A.String s -> pure $ nvStrWithoutContext s
A.Number n ->
Expand Down Expand Up @@ -1876,36 +1879,36 @@ builtinsList = sequence
arity2 :: (a -> b -> c) -> (a -> b -> Prim m c)
arity2 f = ((Prim . pure) .) . f

mkBuiltin :: BuiltinType -> Text -> m (NValue t f m) -> m (Builtin (NValue t f m))
mkBuiltin :: BuiltinType -> VarName -> m (NValue t f m) -> m (Builtin (NValue t f m))
mkBuiltin t n v = wrap t n <$> mkThunk n v
where
wrap :: BuiltinType -> Text -> v -> Builtin v
wrap :: BuiltinType -> VarName -> v -> Builtin v
wrap t n f = Builtin t (n, f)

mkThunk :: Text -> m (NValue t f m) -> m (NValue t f m)
mkThunk :: VarName -> m (NValue t f m) -> m (NValue t f m)
mkThunk n = defer . withFrame Info (ErrorCall $ "While calling builtin " <> toString n <> "\n")

hAdd
:: ( Text
:: ( VarName
-> fun
-> m (NValue t f m)
)
-> BuiltinType
-> Text
-> VarName
-> fun
-> m (Builtin (NValue t f m))
hAdd f t n v = mkBuiltin t n $ f n v

add0
:: BuiltinType
-> Text
-> VarName
-> m (NValue t f m)
-> m (Builtin (NValue t f m))
add0 = hAdd (\ _ x -> x)

add
:: BuiltinType
-> Text
-> VarName
-> ( NValue t f m
-> m (NValue t f m)
)
Expand All @@ -1914,7 +1917,7 @@ builtinsList = sequence

add2
:: BuiltinType
-> Text
-> VarName
-> ( NValue t f m
-> NValue t f m
-> m (NValue t f m)
Expand All @@ -1924,7 +1927,7 @@ builtinsList = sequence

add3
:: BuiltinType
-> Text
-> VarName
-> ( NValue t f m
-> NValue t f m
-> NValue t f m
Expand All @@ -1936,10 +1939,10 @@ builtinsList = sequence
add'
:: ToBuiltin t f m a
=> BuiltinType
-> Text
-> VarName
-> a
-> m (Builtin (NValue t f m))
add' = hAdd toBuiltin
add' = hAdd (toBuiltin . coerce)


-- * Exported
Expand Down Expand Up @@ -1985,12 +1988,17 @@ builtins =
lst <- ([("builtins", ref)] <>) <$> topLevelBuiltins
pushScope (M.fromList lst) currentScopes
where
buildMap
:: ( MonadNix e t f m
, Scoped (NValue t f m) m
)
=> m (HashMap VarName (NValue t f m))
buildMap = fmap (M.fromList . fmap mapping) builtinsList
topLevelBuiltins = mapping <<$>> fullBuiltinsList

fullBuiltinsList = nameBuiltins <<$>> builtinsList
where
nameBuiltins b@(Builtin TopLevel _) = b
nameBuiltins (Builtin Normal nB) =
Builtin TopLevel $ first ("__" <>) nB
Builtin TopLevel $ first (coerce @Text . ("__" <>) . coerce @VarName) nB

Loading

0 comments on commit a65d6bb

Please sign in to comment.