Skip to content

Commit

Permalink
Use Lens.Micro.Lens' and Lens.Micro.lens where appropriate
Browse files Browse the repository at this point in the history
  • Loading branch information
mmhat committed Feb 13, 2025
1 parent 68eb359 commit a902587
Show file tree
Hide file tree
Showing 4 changed files with 60 additions and 80 deletions.
72 changes: 28 additions & 44 deletions dhall/src/Dhall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ import Dhall.Parser (Src (..))
import Dhall.Syntax (Expr (..), Import)
import Dhall.TypeCheck (DetailedTypeError (..), TypeError)
import GHC.Generics
import Lens.Micro (LensLike')
import Lens.Micro (Lens', lens)
import Lens.Micro.Extras (view)
import Prelude hiding (maybe, sequence)
import System.FilePath (takeDirectory)
Expand Down Expand Up @@ -112,22 +112,16 @@ defaultInputSettings = InputSettings
-- | Access the directory to resolve imports relative to.
--
-- @since 1.16
rootDirectory
:: (Functor f)
=> LensLike' f InputSettings FilePath
rootDirectory k s =
fmap (\x -> s { _rootDirectory = x }) (k (_rootDirectory s))
rootDirectory :: Lens' InputSettings FilePath
rootDirectory = lens _rootDirectory (\s x -> s { _rootDirectory = x })

-- | Access the name of the source to report locations from; this is
-- only used in error messages, so it's okay if this is a best guess
-- or something symbolic.
--
-- @since 1.16
sourceName
:: (Functor f)
=> LensLike' f InputSettings FilePath
sourceName k s =
fmap (\x -> s { _sourceName = x}) (k (_sourceName s))
sourceName :: Lens' InputSettings FilePath
sourceName = lens _sourceName (\s x -> s { _sourceName = x})

-- | @since 1.16
data EvaluateSettings = EvaluateSettings
Expand All @@ -153,59 +147,49 @@ defaultEvaluateSettings = EvaluateSettings
--
-- @since 1.16
startingContext
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Dhall.Context.Context (Expr Src Void))
startingContext = evaluateSettings . l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void))
l k s = fmap (\x -> s { _startingContext = x}) (k (_startingContext s))
:: (HasEvaluateSettings s)
=> Lens' s (Dhall.Context.Context (Expr Src Void))
startingContext =
evaluateSettings
. lens _startingContext (\s x -> s { _startingContext = x})

-- | Access the custom substitutions.
--
-- @since 1.30
substitutions
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Dhall.Substitution.Substitutions Src Void)
substitutions = evaluateSettings . l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void)
l k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s))
:: (HasEvaluateSettings s)
=> Lens' s (Dhall.Substitution.Substitutions Src Void)
substitutions =
evaluateSettings
. lens _substitutions (\s x -> s { _substitutions = x })

-- | Access the custom normalizer.
--
-- @since 1.16
normalizer
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Maybe (Core.ReifiedNormalizer Void))
normalizer = evaluateSettings . l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Maybe (Core.ReifiedNormalizer Void))
l k s = fmap (\x -> s { _normalizer = x }) (k (_normalizer s))
:: (HasEvaluateSettings s)
=> Lens' s (Maybe (Core.ReifiedNormalizer Void))
normalizer =
evaluateSettings
. lens _normalizer (\s x -> s { _normalizer = x })

-- | Access the HTTP manager initializer.
--
-- @since 1.36
newManager
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (IO Dhall.Import.Manager)
newManager = evaluateSettings . l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (IO Dhall.Import.Manager)
l k s = fmap (\x -> s { _newManager = x }) (k (_newManager s))
:: (HasEvaluateSettings s)
=> Lens' s (IO Dhall.Import.Manager)
newManager =
evaluateSettings
. lens _newManager (\s x -> s { _newManager = x })

-- | @since 1.16
class HasEvaluateSettings s where
evaluateSettings
:: (Functor f)
=> LensLike' f s EvaluateSettings
evaluateSettings :: Lens' s EvaluateSettings

instance HasEvaluateSettings InputSettings where
evaluateSettings k s =
fmap (\x -> s { _evaluateSettings = x }) (k (_evaluateSettings s))
evaluateSettings =
lens _evaluateSettings (\s x -> s { _evaluateSettings = x })

instance HasEvaluateSettings EvaluateSettings where
evaluateSettings = id
Expand Down
43 changes: 19 additions & 24 deletions dhall/src/Dhall/Import/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ import Dhall.Core
)
import Dhall.Map (Map)
import Dhall.Parser (Src)
import Lens.Micro (LensLike')
import Lens.Micro (Lens', lens)
import Prettyprinter (Pretty (..))

#ifdef WITH_HTTP
Expand Down Expand Up @@ -164,45 +164,40 @@ emptyStatusWith _newManager _loadOriginHeaders _remote _remoteBytes rootImport =
_cacheWarning = CacheNotWarned

-- | Lens from a `Status` to its `_stack` field
stack :: Functor f => LensLike' f Status (NonEmpty Chained)
stack k s = fmap (\x -> s { _stack = x }) (k (_stack s))
stack :: Lens' Status (NonEmpty Chained)
stack = lens _stack (\s x -> s { _stack = x })

-- | Lens from a `Status` to its `_graph` field
graph :: Functor f => LensLike' f Status [Depends]
graph k s = fmap (\x -> s { _graph = x }) (k (_graph s))
graph :: Lens' Status [Depends]
graph = lens _graph (\s x -> s { _graph = x })

-- | Lens from a `Status` to its `_cache` field
cache :: Functor f => LensLike' f Status (Map Chained ImportSemantics)
cache k s = fmap (\x -> s { _cache = x }) (k (_cache s))
cache :: Lens' Status (Map Chained ImportSemantics)
cache = lens _cache (\s x -> s { _cache = x })

-- | Lens from a `Status` to its `_remote` field
remote
:: Functor f
=> LensLike' f Status (URL -> StateT Status IO Data.Text.Text)
remote k s = fmap (\x -> s { _remote = x }) (k (_remote s))
remote :: Lens' Status (URL -> StateT Status IO Data.Text.Text)
remote = lens _remote (\s x -> s { _remote = x })

-- | Lens from a `Status` to its `_remote` field
remoteBytes
:: Functor f
=> LensLike' f Status (URL -> StateT Status IO Data.ByteString.ByteString)
remoteBytes k s = fmap (\x -> s { _remoteBytes = x }) (k (_remoteBytes s))
remoteBytes :: Lens' Status (URL -> StateT Status IO Data.ByteString.ByteString)
remoteBytes = lens _remoteBytes (\s x -> s { _remoteBytes = x })

-- | Lens from a `Status` to its `_substitutions` field
substitutions :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void)
substitutions k s = fmap (\x -> s { _substitutions = x }) (k (_substitutions s))
substitutions :: Lens' Status (Dhall.Substitution.Substitutions Src Void)
substitutions = lens _substitutions (\s x -> s { _substitutions = x })

-- | Lens from a `Status` to its `_normalizer` field
normalizer :: Functor f => LensLike' f Status (Maybe (ReifiedNormalizer Void))
normalizer k s = fmap (\x -> s {_normalizer = x}) (k (_normalizer s))
normalizer :: Lens' Status (Maybe (ReifiedNormalizer Void))
normalizer = lens _normalizer (\s x -> s {_normalizer = x})

-- | Lens from a `Status` to its `_startingContext` field
startingContext :: Functor f => LensLike' f Status (Context (Expr Src Void))
startingContext k s =
fmap (\x -> s { _startingContext = x }) (k (_startingContext s))
startingContext :: Lens' Status (Context (Expr Src Void))
startingContext = lens _startingContext (\s x -> s { _startingContext = x })

-- | Lens from a `Status` to its `_cacheWarning` field
cacheWarning :: Functor f => LensLike' f Status CacheWarning
cacheWarning k s = fmap (\x -> s { _cacheWarning = x }) (k (_cacheWarning s))
cacheWarning :: Lens' Status CacheWarning
cacheWarning = lens _cacheWarning (\s x -> s { _cacheWarning = x })

{-| This exception indicates that there was an internal error in Dhall's
import-related logic
Expand Down
6 changes: 4 additions & 2 deletions dhall/src/Dhall/Optics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
for convenience
-}

{-# LANGUAGE RankNTypes #-}

module Dhall.Optics
( Optic
, Optic'
Expand All @@ -23,7 +25,7 @@ import Data.Coerce (coerce)
import Data.Monoid (Any (..))
import Data.Functor.Contravariant (Contravariant (contramap))
import Data.Profunctor (Profunctor (dimap))
import Lens.Micro (ASetter, LensLike, LensLike')
import Lens.Micro (ASetter, LensLike, Traversal)
import Lens.Micro.Internal (foldMapOf, (#.))

import qualified Lens.Micro
Expand Down Expand Up @@ -78,7 +80,7 @@ mapMOf = coerce
{-# INLINE mapMOf #-}

-- | Identical to @"Control.Lens.Plated".`Control.Lens.Plated.cosmosOf`@
cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a
cosmosOf :: Traversal s t s t -> Traversal s t s b
cosmosOf d f s = f s *> d (cosmosOf d f) s
{-# INLINE cosmosOf #-}

Expand Down
19 changes: 9 additions & 10 deletions dhall/src/Dhall/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ import qualified Dhall.Map as Map
import Dhall.Pretty (CharacterSet (..))
import qualified Dhall.Pretty
import Dhall.Util (_ERROR, renderExpression)
import Lens.Micro (LensLike')
import Lens.Micro (Lens', lens)
import System.Directory
import System.FilePath

Expand All @@ -65,20 +65,19 @@ defaultOptions = Options
}

-- | Access the character set used to render the package content.
characterSet :: Functor f => LensLike' f Options CharacterSet
characterSet k s =
fmap (\x -> s { optionsCharacterSet = x }) (k (optionsCharacterSet s))
characterSet :: Lens' Options CharacterSet
characterSet = lens optionsCharacterSet (\s x -> s { optionsCharacterSet = x })

-- | Access the file name used for the package file.
packageFileName :: Functor f => LensLike' f Options String
packageFileName k s =
fmap (\x -> s { optionsPackageFileName = x }) (k (optionsPackageFileName s))
packageFileName :: Lens' Options String
packageFileName =
lens optionsPackageFileName (\s x -> s { optionsPackageFileName = x })

-- | Access the packaging mode.
-- See the documentation of 'getPackagePathAndContent'.
packagingMode :: Functor f => LensLike' f Options PackagingMode
packagingMode k s =
fmap (\x -> s { optionsPackagingMode = x }) (k (optionsPackagingMode s))
packagingMode :: Lens' Options PackagingMode
packagingMode =
lens optionsPackagingMode (\s x -> s { optionsPackagingMode = x })

-- | Whether to recursively create a package for each subdirectory or not.
-- See the documentation of 'getPackagePathAndContent'.
Expand Down

0 comments on commit a902587

Please sign in to comment.