2021-07-21 13:43:45 +00:00
|
|
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
2021-07-18 12:39:49 +00:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
2021-07-21 13:43:45 +00:00
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
2020-01-11 20:15:05 +00:00
|
|
|
|
2020-07-21 23:08:58 +00:00
|
|
|
{-|
|
|
|
|
Module : GHCup.Types.Optics
|
|
|
|
Description : GHCup optics
|
|
|
|
Copyright : (c) Julian Ospald, 2020
|
2020-07-30 18:04:02 +00:00
|
|
|
License : LGPL-3.0
|
2020-07-21 23:08:58 +00:00
|
|
|
Maintainer : hasufell@hasufell.de
|
|
|
|
Stability : experimental
|
2021-05-14 21:09:45 +00:00
|
|
|
Portability : portable
|
2020-07-21 23:08:58 +00:00
|
|
|
-}
|
2020-01-11 20:15:05 +00:00
|
|
|
module GHCup.Types.Optics where
|
|
|
|
|
|
|
|
import GHCup.Types
|
|
|
|
|
2021-07-18 12:39:49 +00:00
|
|
|
import Control.Monad.Reader
|
2020-01-11 20:15:05 +00:00
|
|
|
import Data.ByteString ( ByteString )
|
|
|
|
import Optics
|
|
|
|
import URI.ByteString
|
|
|
|
|
|
|
|
makePrisms ''Tool
|
|
|
|
makePrisms ''Architecture
|
|
|
|
makePrisms ''LinuxDistro
|
|
|
|
makePrisms ''Platform
|
|
|
|
makePrisms ''Tag
|
|
|
|
|
|
|
|
makeLenses ''PlatformResult
|
|
|
|
makeLenses ''DownloadInfo
|
|
|
|
makeLenses ''Tag
|
|
|
|
makeLenses ''VersionInfo
|
|
|
|
|
2020-04-25 10:06:41 +00:00
|
|
|
makeLenses ''GHCTargetVersion
|
|
|
|
|
2020-04-10 15:36:27 +00:00
|
|
|
makeLenses ''GHCupInfo
|
2020-01-11 20:15:05 +00:00
|
|
|
|
|
|
|
uriSchemeL' :: Lens' (URIRef Absolute) Scheme
|
|
|
|
uriSchemeL' = lensVL uriSchemeL
|
|
|
|
|
|
|
|
schemeBSL' :: Lens' Scheme ByteString
|
|
|
|
schemeBSL' = lensVL schemeBSL
|
|
|
|
|
|
|
|
authorityL' :: Lens' (URIRef a) (Maybe Authority)
|
|
|
|
authorityL' = lensVL authorityL
|
|
|
|
|
|
|
|
authorityHostL' :: Lens' Authority Host
|
|
|
|
authorityHostL' = lensVL authorityHostL
|
|
|
|
|
|
|
|
authorityPortL' :: Lens' Authority (Maybe Port)
|
|
|
|
authorityPortL' = lensVL authorityPortL
|
|
|
|
|
|
|
|
portNumberL' :: Lens' Port Int
|
|
|
|
portNumberL' = lensVL portNumberL
|
|
|
|
|
|
|
|
hostBSL' :: Lens' Host ByteString
|
|
|
|
hostBSL' = lensVL hostBSL
|
|
|
|
|
|
|
|
pathL' :: Lens' (URIRef a) ByteString
|
|
|
|
pathL' = lensVL pathL
|
|
|
|
|
|
|
|
queryL' :: Lens' (URIRef a) Query
|
|
|
|
queryL' = lensVL queryL
|
2021-07-18 12:39:49 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
----------------------
|
|
|
|
--[ Lens utilities ]--
|
|
|
|
----------------------
|
|
|
|
|
|
|
|
|
|
|
|
gets :: forall f a env m . (MonadReader env m, LabelOptic' f A_Lens env a)
|
|
|
|
=> m a
|
|
|
|
gets = asks (^. labelOptic @f)
|
|
|
|
|
|
|
|
|
|
|
|
getAppState :: MonadReader AppState m => m AppState
|
|
|
|
getAppState = ask
|
|
|
|
|
|
|
|
|
|
|
|
getLeanAppState :: ( MonadReader env m
|
|
|
|
, LabelOptic' "settings" A_Lens env Settings
|
|
|
|
, LabelOptic' "dirs" A_Lens env Dirs
|
|
|
|
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
|
|
|
)
|
|
|
|
=> m LeanAppState
|
|
|
|
getLeanAppState = do
|
|
|
|
s <- gets @"settings"
|
|
|
|
d <- gets @"dirs"
|
|
|
|
k <- gets @"keyBindings"
|
|
|
|
pure (LeanAppState s d k)
|
|
|
|
|
|
|
|
|
|
|
|
getSettings :: ( MonadReader env m
|
|
|
|
, LabelOptic' "settings" A_Lens env Settings
|
|
|
|
)
|
|
|
|
=> m Settings
|
|
|
|
getSettings = gets @"settings"
|
|
|
|
|
|
|
|
|
|
|
|
getDirs :: ( MonadReader env m
|
|
|
|
, LabelOptic' "dirs" A_Lens env Dirs
|
|
|
|
)
|
|
|
|
=> m Dirs
|
|
|
|
getDirs = gets @"dirs"
|
|
|
|
|
|
|
|
|
|
|
|
getKeyBindings :: ( MonadReader env m
|
|
|
|
, LabelOptic' "keyBindings" A_Lens env KeyBindings
|
|
|
|
)
|
|
|
|
=> m KeyBindings
|
|
|
|
getKeyBindings = gets @"keyBindings"
|
|
|
|
|
|
|
|
|
|
|
|
getGHCupInfo :: ( MonadReader env m
|
|
|
|
, LabelOptic' "ghcupInfo" A_Lens env GHCupInfo
|
|
|
|
)
|
|
|
|
=> m GHCupInfo
|
|
|
|
getGHCupInfo = gets @"ghcupInfo"
|
|
|
|
|
|
|
|
|
|
|
|
getPlatformReq :: ( MonadReader env m
|
|
|
|
, LabelOptic' "pfreq" A_Lens env PlatformRequest
|
|
|
|
)
|
|
|
|
=> m PlatformRequest
|
|
|
|
getPlatformReq = gets @"pfreq"
|
|
|
|
|
|
|
|
|
|
|
|
type HasSettings env = (LabelOptic' "settings" A_Lens env Settings)
|
|
|
|
type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
|
|
|
|
type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
|
|
|
|
type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
|
|
|
|
type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
|
|
|
|
|
|
|
|
|
|
|
|
getCache :: (MonadReader env m, HasSettings env) => m Bool
|
|
|
|
getCache = getSettings <&> cache
|
|
|
|
|
|
|
|
|
|
|
|
getDownloader :: (MonadReader env m, HasSettings env) => m Downloader
|
|
|
|
getDownloader = getSettings <&> downloader
|
|
|
|
|
2021-07-21 13:43:45 +00:00
|
|
|
|
|
|
|
instance LabelOptic "dirs" A_Lens Dirs Dirs Dirs Dirs where
|
|
|
|
labelOptic = lens id (\_ d -> d)
|