mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-12-14 10:42:10 +03:00
Core: Internal.Base: explicit export list
This commit is contained in:
parent
2af74986de
commit
d0b58e9e3d
@ -1,6 +1,10 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module System.Nix.Internal.Base
|
||||
( BaseEncoding(Base16,NixBase32,Base64)
|
||||
, encodeWith
|
||||
, decodeWith
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
@ -25,10 +25,6 @@ import Data.List (foldl')
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import System.Nix.Internal.Base
|
||||
( BaseEncoding(Base16,NixBase32,Base64)
|
||||
, encodeWith
|
||||
, decodeWith
|
||||
)
|
||||
import Data.Coerce (coerce)
|
||||
import System.Nix.Internal.Truncation
|
||||
(truncateInNixWay)
|
||||
@ -137,7 +133,7 @@ mkStorePathHash bs =
|
||||
--
|
||||
-- Use is the same as for 'hash'. This runs in constant space, but
|
||||
-- forces the entire bytestring.
|
||||
hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
|
||||
hashLazy :: forall a . ValidAlgo a => BSL.ByteString -> Digest a
|
||||
hashLazy bsl =
|
||||
finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
|
||||
|
||||
|
@ -1,14 +1,14 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-|
|
||||
Description : Representation of Nix store paths.
|
||||
-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
|
||||
module System.Nix.Internal.StorePath where
|
||||
import System.Nix.Internal.Hash ( HashAlgorithm(SHA256)
|
||||
@ -35,10 +35,7 @@ import qualified Data.Attoparsec.Text.Lazy as Parser.Text.Lazy
|
||||
import qualified System.FilePath as FilePath
|
||||
import Data.Hashable ( Hashable(..) )
|
||||
import Data.HashSet ( HashSet )
|
||||
import System.Nix.Internal.Base ( BaseEncoding(..)
|
||||
, encodeWith
|
||||
, decodeWith
|
||||
)
|
||||
import System.Nix.Internal.Base
|
||||
import Data.Coerce ( coerce )
|
||||
|
||||
-- | A path in a Nix store.
|
||||
|
@ -19,9 +19,7 @@ import Test.Tasty.QuickCheck
|
||||
import System.Nix.Hash
|
||||
import System.Nix.StorePath
|
||||
import Arbitrary
|
||||
import System.Nix.Internal.Base ( decodeWith
|
||||
, encodeWith
|
||||
)
|
||||
import System.Nix.Internal.Base
|
||||
import Data.Coerce ( coerce )
|
||||
|
||||
spec_hash :: Spec
|
||||
|
Loading…
Reference in New Issue
Block a user