{-# LANGUAGE TemplateHaskell #-}

{-|
Module      : GHCup.Types.Optics
Description : GHCup optics
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : POSIX
-}
module GHCup.Types.Optics where

import           GHCup.Types

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

makeLenses ''GHCTargetVersion

makeLenses ''GHCupInfo

uriSchemeL' :: Lens' (URIRef Absolute) Scheme
uriSchemeL' :: Lens' URI Scheme
uriSchemeL' = LensVL URI URI Scheme Scheme -> Lens' URI Scheme
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL URI URI Scheme Scheme
uriSchemeL

schemeBSL' :: Lens' Scheme ByteString
schemeBSL' :: Lens' Scheme ByteString
schemeBSL' = LensVL Scheme Scheme ByteString ByteString
-> Lens' Scheme ByteString
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL Scheme Scheme ByteString ByteString
schemeBSL

authorityL' :: Lens' (URIRef a) (Maybe Authority)
authorityL' :: Lens' (URIRef a) (Maybe Authority)
authorityL' = LensVL (URIRef a) (URIRef a) (Maybe Authority) (Maybe Authority)
-> Lens' (URIRef a) (Maybe Authority)
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL forall a. Lens' (URIRef a) (Maybe Authority)
LensVL (URIRef a) (URIRef a) (Maybe Authority) (Maybe Authority)
authorityL

authorityHostL' :: Lens' Authority Host
authorityHostL' :: Lens' Authority Host
authorityHostL' = LensVL Authority Authority Host Host -> Lens' Authority Host
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL Authority Authority Host Host
authorityHostL

authorityPortL' :: Lens' Authority (Maybe Port)
authorityPortL' :: Lens' Authority (Maybe Port)
authorityPortL' = LensVL Authority Authority (Maybe Port) (Maybe Port)
-> Lens' Authority (Maybe Port)
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL Authority Authority (Maybe Port) (Maybe Port)
authorityPortL

portNumberL' :: Lens' Port Int
portNumberL' :: Lens' Port Int
portNumberL' = LensVL Port Port Int Int -> Lens' Port Int
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL Port Port Int Int
portNumberL

hostBSL' :: Lens' Host ByteString
hostBSL' :: Lens' Host ByteString
hostBSL' = LensVL Host Host ByteString ByteString -> Lens' Host ByteString
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL LensVL Host Host ByteString ByteString
hostBSL

pathL' :: Lens' (URIRef a) ByteString
pathL' :: Lens' (URIRef a) ByteString
pathL' = LensVL (URIRef a) (URIRef a) ByteString ByteString
-> Lens' (URIRef a) ByteString
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL forall a. Lens' (URIRef a) ByteString
LensVL (URIRef a) (URIRef a) ByteString ByteString
pathL

queryL' :: Lens' (URIRef a) Query
queryL' :: Lens' (URIRef a) Query
queryL' = LensVL (URIRef a) (URIRef a) Query Query -> Lens' (URIRef a) Query
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL forall a. Lens' (URIRef a) Query
LensVL (URIRef a) (URIRef a) Query Query
queryL