{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns      #-}

module GHCup.Utils.Parsers where


import           GHCup.Errors
import           GHCup.Types
import           GHCup.Types.Optics
import           GHCup.List
import           GHCup.Utils
import           GHCup.Prelude
import           GHCup.Prelude.Logger
import           GHCup.Prelude.Attoparsec as AP
import           GHCup.Prelude.MegaParsec as MP

import           Control.Applicative ((<|>), Alternative(..))
import           Control.Monad (forM, when)
import           Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Data.Aeson
import qualified Data.Attoparsec.ByteString as AP
#if MIN_VERSION_aeson(2,0,0)
#else
import qualified Data.HashMap.Strict as KM
#endif
import           Data.Bifunctor
import           Data.Char               as C
import           Data.Either
import           Data.Functor
import           Data.List                      ( sort, sortBy )
import           Data.Maybe
import           Data.Text                      ( Text )
import           Data.Time.Calendar             ( Day )
import           Data.Time.Format               ( parseTimeM, defaultTimeLocale )
import           Data.Versions
import           Data.Void
import           Data.Variant.Excepts
import           Optics                  hiding ( set )
import           Prelude                 hiding ( appendFile )
import           Safe
import           System.FilePath
import           URI.ByteString          hiding (parseURI)

import qualified Data.ByteString.UTF8          as UTF8
import qualified Data.Text                     as T
import qualified Data.Text.Lazy.Encoding       as LE
import qualified Data.Text.Lazy                as LT
import qualified Text.Megaparsec               as MP
import GHCup.Version

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :set -XDataKinds
-- >>> :set -XTypeApplications
-- >>> :set -XQuasiQuotes
-- >>> import System.Directory
-- >>> import URI.ByteString
-- >>> import qualified Data.Text as T
-- >>> import GHCup.Prelude
-- >>> import GHCup.Download
-- >>> import GHCup.Version
-- >>> import GHCup.Errors
-- >>> import GHCup.Types
-- >>> import GHCup.Utils.Dirs
-- >>> import GHCup.Types.Optics
-- >>> import Data.Versions
-- >>> import Optics
-- >>> import GHCup.Prelude.Version.QQ
-- >>> import qualified Data.Text.Encoding as E
-- >>> import qualified Data.Map.Strict               as M
-- >>> import Control.Monad.Reader
-- >>> import Data.Variant.Excepts
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ GHCup.Utils.parseURI $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (Right ref') <- pure $ GHCup.Utils.parseURI $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ channelURL PrereleasesChannel)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE (getBase ref) >>= liftE . decodeMetadata @GHCupInfo
-- >>> (VRight r') <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE (getBase ref') >>= liftE . decodeMetadata @GHCupInfo
-- >>> let rr = M.unionsWith (M.unionWith (\_ b2 -> b2)) [r, r']
-- >>> let go = flip runReaderT leanAppState . fmap (tVerToText . fst)


    -------------
    --[ Types ]--
    -------------

-- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion
                    | SetToolVersion Version
                    | SetToolTag Tag
                    | SetToolDay Day
                    | SetRecommended
                    | SetNext
                    deriving (SetToolVersion -> SetToolVersion -> Bool
(SetToolVersion -> SetToolVersion -> Bool)
-> (SetToolVersion -> SetToolVersion -> Bool) -> Eq SetToolVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetToolVersion -> SetToolVersion -> Bool
== :: SetToolVersion -> SetToolVersion -> Bool
$c/= :: SetToolVersion -> SetToolVersion -> Bool
/= :: SetToolVersion -> SetToolVersion -> Bool
Eq, Int -> SetToolVersion -> ShowS
[SetToolVersion] -> ShowS
SetToolVersion -> String
(Int -> SetToolVersion -> ShowS)
-> (SetToolVersion -> String)
-> ([SetToolVersion] -> ShowS)
-> Show SetToolVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetToolVersion -> ShowS
showsPrec :: Int -> SetToolVersion -> ShowS
$cshow :: SetToolVersion -> String
show :: SetToolVersion -> String
$cshowList :: [SetToolVersion] -> ShowS
showList :: [SetToolVersion] -> ShowS
Show)

prettyToolVer :: ToolVersion -> String
prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion GHCTargetVersion
v')  = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Text
tVerToText GHCTargetVersion
v'
prettyToolVer (ToolVersion Version
v') = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer Version
v'
prettyToolVer (ToolTag Tag
t)      = Tag -> String
forall a. Show a => a -> String
show Tag
t
prettyToolVer (ToolDay Day
day)    = Day -> String
forall a. Show a => a -> String
show Day
day

toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion GHCTargetVersion
v')) = GHCTargetVersion -> SetToolVersion
SetGHCVersion GHCTargetVersion
v'
toSetToolVer (Just (ToolVersion Version
v')) = Version -> SetToolVersion
SetToolVersion Version
v'
toSetToolVer (Just (ToolTag Tag
t')) = Tag -> SetToolVersion
SetToolTag Tag
t'
toSetToolVer (Just (ToolDay Day
d')) = Day -> SetToolVersion
SetToolDay Day
d'
toSetToolVer Maybe ToolVersion
Nothing = SetToolVersion
SetRecommended


platformParser :: String -> Either String PlatformRequest
platformParser :: String -> Either String PlatformRequest
platformParser String
s' = case Parsec Void Text PlatformRequest
-> String
-> Text
-> Either (ParseErrorBundle Text Void) PlatformRequest
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse (Parsec Void Text PlatformRequest
platformP Parsec Void Text PlatformRequest
-> ParsecT Void Text Identity ()
-> Parsec Void Text PlatformRequest
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof) String
"" (String -> Text
T.pack String
s') of
  Right PlatformRequest
r -> PlatformRequest -> Either String PlatformRequest
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlatformRequest
r
  Left  ParseErrorBundle Text Void
e -> String -> Either String PlatformRequest
forall a b. a -> Either a b
Left (String -> Either String PlatformRequest)
-> String -> Either String PlatformRequest
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
 where
  archP :: MP.Parsec Void Text Architecture
  archP :: Parsec Void Text Architecture
archP = [Parsec Void Text Architecture] -> Parsec Void Text Architecture
forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice' ((\Architecture
x -> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Architecture -> String
archToString Architecture
x) ParsecT Void Text Identity (Tokens Text)
-> Architecture -> Parsec Void Text Architecture
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Architecture
x) (Architecture -> Parsec Void Text Architecture)
-> [Architecture] -> [Parsec Void Text Architecture]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Architecture
forall a. Bounded a => a
minBound..Architecture
forall a. Bounded a => a
maxBound] :: [Architecture]))
  platformP :: MP.Parsec Void Text PlatformRequest
  platformP :: Parsec Void Text PlatformRequest
platformP = [Parsec Void Text PlatformRequest]
-> Parsec Void Text PlatformRequest
forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice'
    [ (Architecture -> Platform -> Maybe Versioning -> PlatformRequest
`PlatformRequest` Platform
FreeBSD)
    (Architecture -> Maybe Versioning -> PlatformRequest)
-> Parsec Void Text Architecture
-> ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parsec Void Text Architecture
archP Parsec Void Text Architecture
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text Architecture
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-")
    ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
-> ParsecT Void Text Identity (Maybe Versioning)
-> Parsec Void Text PlatformRequest
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"portbld"
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (   ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just (Versioning -> Maybe Versioning)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity (Maybe Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text -> ParsecT Void Text Identity Versioning
verP (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
"-freebsd" Parsec Void Text Text
-> ParsecT Void Text Identity () -> Parsec Void Text Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof))
           ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Versioning -> ParsecT Void Text Identity (Maybe Versioning)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Versioning
forall a. Maybe a
Nothing
           )
        ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-freebsd"
        )
    , (Architecture -> Platform -> Maybe Versioning -> PlatformRequest
`PlatformRequest` Platform
Darwin)
    (Architecture -> Maybe Versioning -> PlatformRequest)
-> Parsec Void Text Architecture
-> ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parsec Void Text Architecture
archP Parsec Void Text Architecture
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text Architecture
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-")
    ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
-> ParsecT Void Text Identity (Maybe Versioning)
-> Parsec Void Text PlatformRequest
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"apple"
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (   ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just (Versioning -> Maybe Versioning)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity (Maybe Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text -> ParsecT Void Text Identity Versioning
verP (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
"-darwin" Parsec Void Text Text
-> ParsecT Void Text Identity () -> Parsec Void Text Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof))
           ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Versioning -> ParsecT Void Text Identity (Maybe Versioning)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Versioning
forall a. Maybe a
Nothing
           )
        ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-darwin"
        )
    , (\Architecture
a LinuxDistro
d Maybe Versioning
mv -> Architecture -> Platform -> Maybe Versioning -> PlatformRequest
PlatformRequest Architecture
a (LinuxDistro -> Platform
Linux LinuxDistro
d) Maybe Versioning
mv)
    (Architecture
 -> LinuxDistro -> Maybe Versioning -> PlatformRequest)
-> Parsec Void Text Architecture
-> ParsecT
     Void
     Text
     Identity
     (LinuxDistro -> Maybe Versioning -> PlatformRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parsec Void Text Architecture
archP Parsec Void Text Architecture
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text Architecture
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-")
    ParsecT
  Void
  Text
  Identity
  (LinuxDistro -> Maybe Versioning -> PlatformRequest)
-> ParsecT Void Text Identity LinuxDistro
-> ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity LinuxDistro
distroP
    ParsecT Void Text Identity (Maybe Versioning -> PlatformRequest)
-> ParsecT Void Text Identity (Maybe Versioning)
-> Parsec Void Text PlatformRequest
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just (Versioning -> Maybe Versioning)
-> ParsecT Void Text Identity Versioning
-> ParsecT Void Text Identity (Maybe Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Text -> ParsecT Void Text Identity Versioning
verP (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
Tokens Text
"-linux" Parsec Void Text Text
-> ParsecT Void Text Identity () -> Parsec Void Text Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)) ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Versioning -> ParsecT Void Text Identity (Maybe Versioning)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Versioning
forall a. Maybe a
Nothing
         )
        ParsecT Void Text Identity (Maybe Versioning)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Versioning)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-linux"
        )
    , (\Architecture
a -> Architecture -> Platform -> Maybe Versioning -> PlatformRequest
PlatformRequest Architecture
a Platform
Windows Maybe Versioning
forall a. Maybe a
Nothing)
    (Architecture -> PlatformRequest)
-> Parsec Void Text Architecture
-> Parsec Void Text PlatformRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parsec Void Text Architecture
archP Parsec Void Text Architecture
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text Architecture
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-")
        Parsec Void Text Architecture
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text Architecture
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"unknown-mingw32" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"unknown-windows" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"windows"))
    ]
  distroP :: MP.Parsec Void Text LinuxDistro
  distroP :: ParsecT Void Text Identity LinuxDistro
distroP = [ParsecT Void Text Identity LinuxDistro]
-> ParsecT Void Text Identity LinuxDistro
forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice' ((\LinuxDistro
d -> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ LinuxDistro -> String
distroToString LinuxDistro
d) ParsecT Void Text Identity (Tokens Text)
-> LinuxDistro -> ParsecT Void Text Identity LinuxDistro
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> LinuxDistro
d) (LinuxDistro -> ParsecT Void Text Identity LinuxDistro)
-> [LinuxDistro] -> [ParsecT Void Text Identity LinuxDistro]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LinuxDistro]
allDistros)


uriParser :: String -> Either String URI
uriParser :: String -> Either String URI
uriParser = (URIParseError -> String)
-> Either URIParseError URI -> Either String URI
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first URIParseError -> String
forall a. Show a => a -> String
show (Either URIParseError URI -> Either String URI)
-> (String -> Either URIParseError URI)
-> String
-> Either String URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either URIParseError URI
parseURI (ByteString -> Either URIParseError URI)
-> (String -> ByteString) -> String -> Either URIParseError URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString


absolutePathParser :: FilePath -> Either String FilePath
absolutePathParser :: String -> Either String String
absolutePathParser String
f = case String -> Bool
isValid String
f Bool -> Bool -> Bool
&& String -> Bool
isAbsolute String
f of
              Bool
True -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ ShowS
normalise String
f
              Bool
False -> String -> Either String String
forall a b. a -> Either a b
Left String
"Please enter a valid absolute filepath."

isolateParser :: FilePath -> Either String FilePath
isolateParser :: String -> Either String String
isolateParser String
f = case String -> Bool
isValid String
f Bool -> Bool -> Bool
&& String -> Bool
isAbsolute String
f of
              Bool
True -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ ShowS
normalise String
f
              Bool
False -> String -> Either String String
forall a b. a -> Either a b
Left String
"Please enter a valid filepath for isolate dir."

-- this accepts cross prefix
ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither String
s' =
  (Day -> ToolVersion)
-> Either String Day -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Day -> ToolVersion
ToolDay (String -> Either String Day
dayParser String
s') Either String ToolVersion
-> Either String ToolVersion -> Either String ToolVersion
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tag -> ToolVersion)
-> Either String Tag -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Tag -> ToolVersion
ToolTag (String -> Either String Tag
tagEither String
s') Either String ToolVersion
-> Either String ToolVersion -> Either String ToolVersion
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GHCTargetVersion -> ToolVersion)
-> Either String GHCTargetVersion -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second GHCTargetVersion -> ToolVersion
GHCVersion (String -> Either String GHCTargetVersion
ghcVersionEither String
s')

-- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither String
s' =
  (Day -> ToolVersion)
-> Either String Day -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Day -> ToolVersion
ToolDay (String -> Either String Day
dayParser String
s') Either String ToolVersion
-> Either String ToolVersion -> Either String ToolVersion
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tag -> ToolVersion)
-> Either String Tag -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Tag -> ToolVersion
ToolTag (String -> Either String Tag
tagEither String
s') Either String ToolVersion
-> Either String ToolVersion -> Either String ToolVersion
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Version -> ToolVersion)
-> Either String Version -> Either String ToolVersion
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Version -> ToolVersion
ToolVersion (String -> Either String Version
toolVersionEither String
s')

tagEither :: String -> Either String Tag
tagEither :: String -> Either String Tag
tagEither String
s' = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower String
s' of
  String
"recommended"              -> Tag -> Either String Tag
forall a b. b -> Either a b
Right Tag
Recommended
  String
"latest"                   -> Tag -> Either String Tag
forall a b. b -> Either a b
Right Tag
Latest
  String
"latest-prerelease"        -> Tag -> Either String Tag
forall a b. b -> Either a b
Right Tag
LatestPrerelease
  String
"latest-nightly"           -> Tag -> Either String Tag
forall a b. b -> Either a b
Right Tag
LatestNightly
  (Char
'b':Char
'a':Char
's':Char
'e':Char
'-':String
ver') -> case Text -> Either (ParseErrorBundle Text Void) PVP
pvp (String -> Text
T.pack String
ver') of
                                  Right PVP
x -> Tag -> Either String Tag
forall a b. b -> Either a b
Right (PVP -> Tag
Base PVP
x)
                                  Left  ParseErrorBundle Text Void
_ -> String -> Either String Tag
forall a b. a -> Either a b
Left (String -> Either String Tag) -> String -> Either String Tag
forall a b. (a -> b) -> a -> b
$ String
"Invalid PVP version for base " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ver'
  String
other                      -> String -> Either String Tag
forall a b. a -> Either a b
Left (String -> Either String Tag) -> String -> Either String Tag
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
other


ghcVersionEither :: String -> Either String GHCTargetVersion
ghcVersionEither :: String -> Either String GHCTargetVersion
ghcVersionEither =
  (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
-> Either String GHCTargetVersion
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ParseErrorBundle Text Void -> String
forall a b. a -> b -> a
const String
"Not a valid version") (Either (ParseErrorBundle Text Void) GHCTargetVersion
 -> Either String GHCTargetVersion)
-> (String -> Either (ParseErrorBundle Text Void) GHCTargetVersion)
-> String
-> Either String GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text GHCTargetVersion
-> String
-> Text
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
ghcTargetVerP String
"" (Text -> Either (ParseErrorBundle Text Void) GHCTargetVersion)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

toolVersionEither :: String -> Either String Version
toolVersionEither :: String -> Either String Version
toolVersionEither =
  (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) Version
-> Either String Version
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ParseErrorBundle Text Void -> String
forall a b. a -> b -> a
const String
"Not a valid version") (Either (ParseErrorBundle Text Void) Version
 -> Either String Version)
-> (String -> Either (ParseErrorBundle Text Void) Version)
-> String
-> Either String Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> String -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse (Parsec Void Text Version
version' Parsec Void Text Version
-> ParsecT Void Text Identity () -> Parsec Void Text Version
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof) String
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


toolParser :: String -> Either String Tool
toolParser :: String -> Either String Tool
toolParser String
s' | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"ghc"   = Tool -> Either String Tool
forall a b. b -> Either a b
Right Tool
GHC
              | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"cabal" = Tool -> Either String Tool
forall a b. b -> Either a b
Right Tool
Cabal
              | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"hls"   = Tool -> Either String Tool
forall a b. b -> Either a b
Right Tool
HLS
              | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"stack" = Tool -> Either String Tool
forall a b. b -> Either a b
Right Tool
Stack
              | Bool
otherwise           = String -> Either String Tool
forall a b. a -> Either a b
Left (String
"Unknown tool: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s')
  where t :: Text
t = Text -> Text
T.toLower (String -> Text
T.pack String
s')

dayParser :: String -> Either String Day
dayParser :: String -> Either String Day
dayParser String
s = Either String Day
-> (Day -> Either String Day) -> Maybe Day -> Either String Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Day
forall a b. a -> Either a b
Left (String -> Either String Day) -> String -> Either String Day
forall a b. (a -> b) -> a -> b
$ String
"Could not parse \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\". Expected format is: YYYY-MM-DD") Day -> Either String Day
forall a b. b -> Either a b
Right
            (Maybe Day -> Either String Day) -> Maybe Day -> Either String Day
forall a b. (a -> b) -> a -> b
$ Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%-m-%-d" String
s


criteriaParser :: String -> Either String ListCriteria
criteriaParser :: String -> Either String ListCriteria
criteriaParser String
s' | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"installed"   = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListInstalled Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"set"         = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListSet Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"available"   = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListAvailable Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"+installed"  = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListInstalled Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"+set"        = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListSet Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"+available"  = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListAvailable Bool
True
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"-installed"  = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListInstalled Bool
False
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"-set"        = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListSet Bool
False
                  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"-available"  = ListCriteria -> Either String ListCriteria
forall a b. b -> Either a b
Right (ListCriteria -> Either String ListCriteria)
-> ListCriteria -> Either String ListCriteria
forall a b. (a -> b) -> a -> b
$ Bool -> ListCriteria
ListAvailable Bool
False
                  | Bool
otherwise                 = String -> Either String ListCriteria
forall a b. a -> Either a b
Left (String
"Unknown criteria: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s')
  where t :: Text
t = Text -> Text
T.toLower (String -> Text
T.pack String
s')



keepOnParser :: String -> Either String KeepDirs
keepOnParser :: String -> Either String KeepDirs
keepOnParser String
s' | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"always" = KeepDirs -> Either String KeepDirs
forall a b. b -> Either a b
Right KeepDirs
Always
                | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"errors" = KeepDirs -> Either String KeepDirs
forall a b. b -> Either a b
Right KeepDirs
Errors
                | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"never"  = KeepDirs -> Either String KeepDirs
forall a b. b -> Either a b
Right KeepDirs
Never
                | Bool
otherwise            = String -> Either String KeepDirs
forall a b. a -> Either a b
Left (String
"Unknown keep value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s')
  where t :: Text
t = Text -> Text
T.toLower (String -> Text
T.pack String
s')


downloaderParser :: String -> Either String Downloader
downloaderParser :: String -> Either String Downloader
downloaderParser String
s' | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"curl"     = Downloader -> Either String Downloader
forall a b. b -> Either a b
Right Downloader
Curl
                    | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"wget"     = Downloader -> Either String Downloader
forall a b. b -> Either a b
Right Downloader
Wget
#if defined(INTERNAL_DOWNLOADER)
                    | t == T.pack "internal" = Right Internal
#endif
                    | Bool
otherwise = String -> Either String Downloader
forall a b. a -> Either a b
Left (String
"Unknown downloader value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s')
  where t :: Text
t = Text -> Text
T.toLower (String -> Text
T.pack String
s')

gpgParser :: String -> Either String GPGSetting
gpgParser :: String -> Either String GPGSetting
gpgParser String
s' | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"strict" = GPGSetting -> Either String GPGSetting
forall a b. b -> Either a b
Right GPGSetting
GPGStrict
             | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"lax"    = GPGSetting -> Either String GPGSetting
forall a b. b -> Either a b
Right GPGSetting
GPGLax
             | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
"none"   = GPGSetting -> Either String GPGSetting
forall a b. b -> Either a b
Right GPGSetting
GPGNone
             | Bool
otherwise = String -> Either String GPGSetting
forall a b. a -> Either a b
Left (String
"Unknown gpg setting value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s')
  where t :: Text
t = Text -> Text
T.toLower (String -> Text
T.pack String
s')



overWriteVersionParser :: String -> Either String [VersionPattern]
overWriteVersionParser :: String -> Either String [VersionPattern]
overWriteVersionParser = (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) [VersionPattern]
-> Either String [VersionPattern]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ParseErrorBundle Text Void -> String
forall a b. a -> b -> a
const String
"Not a valid version pattern") (Either (ParseErrorBundle Text Void) [VersionPattern]
 -> Either String [VersionPattern])
-> (String -> Either (ParseErrorBundle Text Void) [VersionPattern])
-> String
-> Either String [VersionPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text [VersionPattern]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [VersionPattern]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse (ParsecT Void Text Identity VersionPattern
-> Parsec Void Text [VersionPattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void Text Identity VersionPattern
versionPattern Parsec Void Text [VersionPattern]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [VersionPattern]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof) String
"" (Text -> Either (ParseErrorBundle Text Void) [VersionPattern])
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) [VersionPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
 where
  versionPattern :: MP.Parsec Void Text VersionPattern
  versionPattern :: ParsecT Void Text Identity VersionPattern
versionPattern = do
    String
str' <- Text -> String
T.unpack (Text -> String)
-> Parsec Void Text Text -> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'%')
    if String
str' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
forall a. Monoid a => a
mempty
    then VersionPattern -> ParsecT Void Text Identity VersionPattern
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> VersionPattern
S String
str')
    else     (Tokens Text -> VersionPattern)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity VersionPattern
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionPattern -> Tokens Text -> VersionPattern
forall a b. a -> b -> a
const VersionPattern
CabalVer)      ParsecT Void Text Identity (Tokens Text)
v_cabal
         ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> VersionPattern)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity VersionPattern
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionPattern -> Tokens Text -> VersionPattern
forall a b. a -> b -> a
const VersionPattern
GitBranchName) ParsecT Void Text Identity (Tokens Text)
b_name
         ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> VersionPattern)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity VersionPattern
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionPattern -> Tokens Text -> VersionPattern
forall a b. a -> b -> a
const VersionPattern
GitHashShort)  ParsecT Void Text Identity (Tokens Text)
s_hash
         ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> VersionPattern)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity VersionPattern
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionPattern -> Tokens Text -> VersionPattern
forall a b. a -> b -> a
const VersionPattern
GitHashLong)   ParsecT Void Text Identity (Tokens Text)
l_hash
         ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> VersionPattern)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity VersionPattern
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VersionPattern -> Tokens Text -> VersionPattern
forall a b. a -> b -> a
const VersionPattern
GitDescribe)   ParsecT Void Text Identity (Tokens Text)
g_desc
         ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
-> ParsecT Void Text Identity VersionPattern
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Char
a Text
b -> String -> VersionPattern
S (Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: Text -> String
T.unpack Text
b)) (Char -> Text -> VersionPattern)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Text -> VersionPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) ParsecT Void Text Identity (Text -> VersionPattern)
-> Parsec Void Text Text
-> ParsecT Void Text Identity VersionPattern
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Token Text
'%')) -- invalid pattern, e.g. "%k"
   where
    v_cabal :: ParsecT Void Text Identity (Tokens Text)
v_cabal = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"%v"
    b_name :: ParsecT Void Text Identity (Tokens Text)
b_name  = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"%b"
    s_hash :: ParsecT Void Text Identity (Tokens Text)
s_hash  = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"%h"
    l_hash :: ParsecT Void Text Identity (Tokens Text)
l_hash  = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"%H"
    g_desc :: ParsecT Void Text Identity (Tokens Text)
g_desc  = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"%g"

    -----------------
    --[ Utilities ]--
    -----------------


fromVersion :: ( HasLog env
               , MonadFail m
               , MonadReader env m
               , HasGHCupInfo env
               , HasDirs env
               , MonadThrow m
               , MonadIO m
               , MonadCatch m
               )
            => Maybe ToolVersion
            -> GuessMode
            -> Tool
            -> Excepts
                 '[ TagNotFound
                  , DayNotFound
                  , NextVerNotFound
                  , NoToolVersionSet
                  ] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion :: forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
 HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
tv = SetToolVersion
-> GuessMode
-> Tool
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
 HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
SetToolVersion
-> GuessMode
-> Tool
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
fromVersion' (Maybe ToolVersion -> SetToolVersion
toSetToolVer Maybe ToolVersion
tv)

fromVersion' :: ( HasLog env
                , MonadFail m
                , MonadReader env m
                , HasGHCupInfo env
                , HasDirs env
                , MonadThrow m
                , MonadIO m
                , MonadCatch m
                )
             => SetToolVersion
             -> GuessMode
             -> Tool
             -> Excepts
                  '[ TagNotFound
                   , DayNotFound
                   , NextVerNotFound
                   , NoToolVersionSet
                   ] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' :: forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
 HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
SetToolVersion
-> GuessMode
-> Tool
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetToolVersion
SetRecommended GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getRecommended GHCupDownloads
dls Tool
tool
    Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound Tag
Recommended Tool
tool
fromVersion' (SetGHCVersion GHCTargetVersion
v) GuessMode
guessMode Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  m (GHCTargetVersion, Maybe VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (GHCTargetVersion, Maybe VersionInfo)
 -> Excepts
      '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
      m
      (GHCTargetVersion, Maybe VersionInfo))
-> m (GHCTargetVersion, Maybe VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ GHCupDownloads
-> GHCTargetVersion
-> Tool
-> GuessMode
-> m (GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasDirs env,
 MonadThrow m, MonadIO m, MonadCatch m) =>
GHCupDownloads
-> GHCTargetVersion
-> Tool
-> GuessMode
-> m (GHCTargetVersion, Maybe VersionInfo)
guessFullVersion GHCupDownloads
dls GHCTargetVersion
v Tool
tool GuessMode
guessMode
fromVersion' (SetToolVersion (Version -> GHCTargetVersion
mkTVer -> GHCTargetVersion
v)) GuessMode
guessMode Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  m (GHCTargetVersion, Maybe VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (GHCTargetVersion, Maybe VersionInfo)
 -> Excepts
      '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
      m
      (GHCTargetVersion, Maybe VersionInfo))
-> m (GHCTargetVersion, Maybe VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ GHCupDownloads
-> GHCTargetVersion
-> Tool
-> GuessMode
-> m (GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasDirs env,
 MonadThrow m, MonadIO m, MonadCatch m) =>
GHCupDownloads
-> GHCTargetVersion
-> Tool
-> GuessMode
-> m (GHCTargetVersion, Maybe VersionInfo)
guessFullVersion GHCupDownloads
dls GHCTargetVersion
v Tool
tool GuessMode
guessMode
fromVersion' (SetToolTag Tag
Latest) GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest GHCupDownloads
dls Tool
tool Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound Tag
Latest Tool
tool
fromVersion' (SetToolDay Day
day) GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case GHCupDownloads
-> Tool
-> Day
-> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
getByReleaseDay GHCupDownloads
dls Tool
tool Day
day of
                          Left Maybe Day
ad -> DayNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DayNotFound
 -> Excepts
      '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
      m
      (GHCTargetVersion, VersionInfo))
-> DayNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall a b. (a -> b) -> a -> b
$ Day -> Tool -> Maybe Day -> DayNotFound
DayNotFound Day
day Tool
tool Maybe Day
ad
                          Right (GHCTargetVersion, VersionInfo)
v -> (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall a.
a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion, VersionInfo)
v
fromVersion' (SetToolTag Tag
LatestPrerelease) GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestPrerelease GHCupDownloads
dls Tool
tool Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound Tag
LatestPrerelease Tool
tool
fromVersion' (SetToolTag Tag
LatestNightly) GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestNightly GHCupDownloads
dls Tool
tool Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound Tag
LatestNightly Tool
tool
fromVersion' (SetToolTag Tag
Recommended) GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getRecommended GHCupDownloads
dls Tool
tool Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound Tag
Recommended Tool
tool
fromVersion' (SetToolTag (Base PVP
pvp'')) GuessMode
_ Tool
GHC = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  (VersionInfo -> Maybe VersionInfo)
-> (GHCTargetVersion, VersionInfo)
-> (GHCTargetVersion, Maybe VersionInfo)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just ((GHCTargetVersion, VersionInfo)
 -> (GHCTargetVersion, Maybe VersionInfo))
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
getLatestBaseVersion GHCupDownloads
dls PVP
pvp'' Maybe (GHCTargetVersion, VersionInfo)
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tag -> Tool -> TagNotFound
TagNotFound (PVP -> Tag
Base PVP
pvp'') Tool
GHC
fromVersion' SetToolVersion
SetNext GuessMode
_ Tool
tool = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  GHCTargetVersion
next <- case Tool
tool of
    Tool
GHC -> do
      Version
set <- (GHCTargetVersion -> Version)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     Version
forall a b.
(a -> b)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHCTargetVersion -> Version
_tvVersion (Excepts
   '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
   m
   GHCTargetVersion
 -> Excepts
      '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
      m
      Version)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     Version
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing m (Maybe GHCTargetVersion)
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
      [GHCTargetVersion]
ghcs <- [Either String GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights ([Either String GHCTargetVersion] -> [GHCTargetVersion])
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String GHCTargetVersion]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String GHCTargetVersion]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String GHCTargetVersion]
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Either String GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either String GHCTargetVersion]
getInstalledGHCs
      ([GHCTargetVersion] -> Maybe GHCTargetVersion
forall a. [a] -> Maybe a
headMay
        ([GHCTargetVersion] -> Maybe GHCTargetVersion)
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GHCTargetVersion] -> [GHCTargetVersion]
forall a. HasCallStack => [a] -> [a]
tail
        ([GHCTargetVersion] -> [GHCTargetVersion])
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> [GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCTargetVersion -> Bool)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\GHCTargetVersion {Maybe Text
Version
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
_tvTarget :: Maybe Text
_tvVersion :: Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
..} -> Version
_tvVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
set)
        ([GHCTargetVersion] -> [GHCTargetVersion])
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> [GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GHCTargetVersion] -> [GHCTargetVersion]
forall a. HasCallStack => [a] -> [a]
cycle
        ([GHCTargetVersion] -> [GHCTargetVersion])
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> [GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCTargetVersion -> GHCTargetVersion -> Ordering)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\GHCTargetVersion
x GHCTargetVersion
y -> Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
x) (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
y))
        ([GHCTargetVersion] -> [GHCTargetVersion])
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> [GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCTargetVersion -> Bool)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\GHCTargetVersion {Maybe Text
Version
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
_tvTarget :: Maybe Text
_tvVersion :: Version
..} -> Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
_tvTarget)
        ([GHCTargetVersion] -> Maybe GHCTargetVersion)
-> [GHCTargetVersion] -> Maybe GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ [GHCTargetVersion]
ghcs) Maybe GHCTargetVersion
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
    Tool
Cabal -> do
      Version
set <- m (Maybe Version)
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadIO m,
 MonadThrow m, MonadCatch m) =>
m (Maybe Version)
cabalSet m (Maybe Version)
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
      [Version]
cabals <- [Either String Version] -> [Version]
forall a b. [Either a b] -> [b]
rights ([Either String Version] -> [Version])
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledCabals
      ((Version -> GHCTargetVersion)
-> Maybe Version -> Maybe GHCTargetVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing)
        (Maybe Version -> Maybe GHCTargetVersion)
-> ([Version] -> Maybe Version)
-> [Version]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay
        ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
tail
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
set)
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
cycle
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort
        ([Version] -> Maybe GHCTargetVersion)
-> [Version] -> Maybe GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ [Version]
cabals) Maybe GHCTargetVersion
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
    Tool
HLS -> do
      Version
set <- m (Maybe Version)
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadIO m,
 MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet m (Maybe Version)
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
      [Version]
hlses <- [Either String Version] -> [Version]
forall a b. [Either a b] -> [b]
rights ([Either String Version] -> [Version])
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledHLSs
      ((Version -> GHCTargetVersion)
-> Maybe Version -> Maybe GHCTargetVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing)
        (Maybe Version -> Maybe GHCTargetVersion)
-> ([Version] -> Maybe Version)
-> [Version]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay
        ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
tail
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
set)
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
cycle
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort
        ([Version] -> Maybe GHCTargetVersion)
-> [Version] -> Maybe GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ [Version]
hlses) Maybe GHCTargetVersion
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
    Tool
Stack -> do
      Version
set <- m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m, HasLog env) =>
m (Maybe Version)
stackSet m (Maybe Version)
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
      [Version]
stacks <- [Either String Version] -> [Version]
forall a b. [Either a b] -> [b]
rights ([Either String Version] -> [Version])
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     [Either String Version]
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledStacks
      ((Version -> GHCTargetVersion)
-> Maybe Version -> Maybe GHCTargetVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing)
        (Maybe Version -> Maybe GHCTargetVersion)
-> ([Version] -> Maybe Version)
-> [Version]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay
        ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
tail
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
set)
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. HasCallStack => [a] -> [a]
cycle
        ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort
        ([Version] -> Maybe GHCTargetVersion)
-> [Version] -> Maybe GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ [Version]
stacks) Maybe GHCTargetVersion
-> NoToolVersionSet
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? Tool -> NoToolVersionSet
NoToolVersionSet Tool
tool
    Tool
GHCup -> String
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     GHCTargetVersion
forall a.
String
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"GHCup cannot be set"
  let vi :: Maybe VersionInfo
vi = GHCTargetVersion -> Tool -> GHCupDownloads -> Maybe VersionInfo
getVersionInfo GHCTargetVersion
next Tool
tool GHCupDownloads
dls
  (GHCTargetVersion, Maybe VersionInfo)
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall a.
a
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion
next, Maybe VersionInfo
vi)
fromVersion' (SetToolTag Tag
t') GuessMode
_ Tool
tool =
  TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (TagNotFound
 -> Excepts
      '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
      m
      (GHCTargetVersion, Maybe VersionInfo))
-> TagNotFound
-> Excepts
     '[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
     m
     (GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Tag -> Tool -> TagNotFound
TagNotFound Tag
t' Tool
tool

-- | Guess the full version from an input version, by possibly
-- examining the metadata and the installed versions.
--
-- >>> go $ guessFullVersion rr (mkTVer [vver|8|]) GHC GLax
-- "8.10.7"
-- >>> go $ guessFullVersion rr (mkTVer [vver|8.10|]) GHC GLax
-- "8.10.7"
-- >>> go $ guessFullVersion rr (mkTVer [vver|8.10.7|]) GHC GLax
-- "8.10.7"
-- >>> go $ guessFullVersion rr (mkTVer [vver|9.12.1|]) GHC GLax
-- "9.12.1"
-- >>> go $ guessFullVersion rr (mkTVer [vver|8|]) GHC GStrict
-- "8"
guessFullVersion :: ( HasLog env
                    , MonadFail m
                    , MonadReader env m
                    , HasDirs env
                    , MonadThrow m
                    , MonadIO m
                    , MonadCatch m
                    )
                 => GHCupDownloads
                 -> GHCTargetVersion
                 -> Tool
                 -> GuessMode
                 -> m (GHCTargetVersion, Maybe VersionInfo)
guessFullVersion :: forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasDirs env,
 MonadThrow m, MonadIO m, MonadCatch m) =>
GHCupDownloads
-> GHCTargetVersion
-> Tool
-> GuessMode
-> m (GHCTargetVersion, Maybe VersionInfo)
guessFullVersion GHCupDownloads
dls GHCTargetVersion
v Tool
tool GuessMode
guessMode = do
  let vi :: Maybe VersionInfo
vi = GHCTargetVersion -> Tool -> GHCupDownloads -> Maybe VersionInfo
getVersionInfo GHCTargetVersion
v Tool
tool GHCupDownloads
dls
  case Text -> Either (ParseErrorBundle Text Void) PVP
pvp (Text -> Either (ParseErrorBundle Text Void) PVP)
-> Text -> Either (ParseErrorBundle Text Void) PVP
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
v) of -- need to be strict here
    Left ParseErrorBundle Text Void
_ -> (GHCTargetVersion, Maybe VersionInfo)
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion
v, Maybe VersionInfo
vi)
    Right PVP
pvpIn
      | (GuessMode
guessMode GuessMode -> GuessMode -> Bool
forall a. Eq a => a -> a -> Bool
/= GuessMode
GStrict) Bool -> Bool -> Bool
&& Optic' An_AffineTraversal '[] GHCupDownloads VersionInfo
-> GHCupDownloads -> Bool
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Bool
hasn't (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map GHCTargetVersion VersionInfo)
  (Map GHCTargetVersion VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map GHCTargetVersion VersionInfo)
     (Map GHCTargetVersion VersionInfo)
     VersionInfo
     VersionInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map GHCTargetVersion VersionInfo)
-> Optic'
     (IxKind (Map GHCTargetVersion VersionInfo))
     '[]
     (Map GHCTargetVersion VersionInfo)
     (IxValue (Map GHCTargetVersion VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map GHCTargetVersion VersionInfo)
GHCTargetVersion
v) GHCupDownloads
dls -> do
          [GHCTargetVersion]
ghcs <- if GuessMode
guessMode GuessMode -> GuessMode -> Bool
forall a. Eq a => a -> a -> Bool
== GuessMode
GLaxWithInstalled then ([Either String GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either String GHCTargetVersion] -> m [GHCTargetVersion]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either String GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either String GHCTargetVersion]
getInstalledTools else [GHCTargetVersion] -> m [GHCTargetVersion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          if GHCTargetVersion
v GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCTargetVersion]
ghcs
          then Tool
-> Maybe Text
-> PVP
-> GHCupDownloads
-> m (Maybe (PVP, VersionInfo, Maybe Text))
forall (m :: * -> *).
MonadThrow m =>
Tool
-> Maybe Text
-> PVP
-> GHCupDownloads
-> m (Maybe (PVP, VersionInfo, Maybe Text))
getLatestToolFor Tool
tool (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
v) PVP
pvpIn GHCupDownloads
dls m (Maybe (PVP, VersionInfo, Maybe Text))
-> (Maybe (PVP, VersionInfo, Maybe Text)
    -> m (GHCTargetVersion, Maybe VersionInfo))
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 Just (PVP
pvp_, VersionInfo
vi', Maybe Text
mt) -> do
                   Version
v' <- PVP -> Text -> m Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
pvp_ Text
""
                   Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
v' Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
v) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text
"Assuming you meant version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
v')
                   (GHCTargetVersion, Maybe VersionInfo)
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
mt Version
v', VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just VersionInfo
vi')
                 Maybe (PVP, VersionInfo, Maybe Text)
Nothing -> (GHCTargetVersion, Maybe VersionInfo)
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion
v, Maybe VersionInfo
vi)
          else (GHCTargetVersion, Maybe VersionInfo)
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion
v, Maybe VersionInfo
vi)
    Either (ParseErrorBundle Text Void) PVP
_ -> (GHCTargetVersion, Maybe VersionInfo)
-> m (GHCTargetVersion, Maybe VersionInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCTargetVersion
v, Maybe VersionInfo
vi)
 where
  getInstalledTools :: m [Either String GHCTargetVersion]
getInstalledTools = case Tool
tool of
                        Tool
GHC -> m [Either String GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either String GHCTargetVersion]
getInstalledGHCs
                        Tool
Cabal -> ((Either String Version -> Either String GHCTargetVersion)
-> [Either String Version] -> [Either String GHCTargetVersion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either String Version -> Either String GHCTargetVersion)
 -> [Either String Version] -> [Either String GHCTargetVersion])
-> ((Version -> GHCTargetVersion)
    -> Either String Version -> Either String GHCTargetVersion)
-> (Version -> GHCTargetVersion)
-> [Either String Version]
-> [Either String GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> GHCTargetVersion)
-> Either String Version -> Either String GHCTargetVersion
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Version -> GHCTargetVersion
mkTVer ([Either String Version] -> [Either String GHCTargetVersion])
-> m [Either String Version] -> m [Either String GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledCabals
                        Tool
HLS -> ((Either String Version -> Either String GHCTargetVersion)
-> [Either String Version] -> [Either String GHCTargetVersion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either String Version -> Either String GHCTargetVersion)
 -> [Either String Version] -> [Either String GHCTargetVersion])
-> ((Version -> GHCTargetVersion)
    -> Either String Version -> Either String GHCTargetVersion)
-> (Version -> GHCTargetVersion)
-> [Either String Version]
-> [Either String GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> GHCTargetVersion)
-> Either String Version -> Either String GHCTargetVersion
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Version -> GHCTargetVersion
mkTVer ([Either String Version] -> [Either String GHCTargetVersion])
-> m [Either String Version] -> m [Either String GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledHLSs
                        Tool
Stack -> ((Either String Version -> Either String GHCTargetVersion)
-> [Either String Version] -> [Either String GHCTargetVersion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either String Version -> Either String GHCTargetVersion)
 -> [Either String Version] -> [Either String GHCTargetVersion])
-> ((Version -> GHCTargetVersion)
    -> Either String Version -> Either String GHCTargetVersion)
-> (Version -> GHCTargetVersion)
-> [Either String Version]
-> [Either String GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> GHCTargetVersion)
-> Either String Version -> Either String GHCTargetVersion
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Version -> GHCTargetVersion
mkTVer ([Either String Version] -> [Either String GHCTargetVersion])
-> m [Either String Version] -> m [Either String GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either String Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either String Version]
getInstalledStacks
                        Tool
GHCup -> [Either String GHCTargetVersion]
-> m [Either String GHCTargetVersion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


parseUrlSource :: String -> Either String [NewURLSource]
parseUrlSource :: String -> Either String [NewURLSource]
parseUrlSource String
s = (URLSource -> [NewURLSource]
fromURLSource (URLSource -> [NewURLSource])
-> Either String URLSource -> Either String [NewURLSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String URLSource
parseUrlSource' String
s)
               Either String [NewURLSource]
-> Either String [NewURLSource] -> Either String [NewURLSource]
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((NewURLSource -> [NewURLSource] -> [NewURLSource]
forall a. a -> [a] -> [a]
:[]) (NewURLSource -> [NewURLSource])
-> Either String NewURLSource -> Either String [NewURLSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String NewURLSource
parseNewUrlSource String
s)
               Either String [NewURLSource]
-> Either String [NewURLSource] -> Either String [NewURLSource]
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Either String [NewURLSource]
parseNewUrlSources String
s

parseUrlSource' :: String -> Either String URLSource
parseUrlSource' :: String -> Either String URLSource
parseUrlSource' String
"GHCupURL" = URLSource -> Either String URLSource
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URLSource
GHCupURL
parseUrlSource' String
"StackSetupURL" = URLSource -> Either String URLSource
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URLSource
StackSetupURL
parseUrlSource' String
s' = (ByteString -> Either String URLSource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String URLSource)
-> (String -> ByteString) -> String -> Either String URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack (String -> Either String URLSource)
-> String -> Either String URLSource
forall a b. (a -> b) -> a -> b
$ String
s')
            Either String URLSource
-> Either String URLSource -> Either String URLSource
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((URI -> URLSource) -> Either String URI -> Either String URLSource
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource
OwnSource ([Either (Either GHCupInfo SetupInfo) URI] -> URLSource)
-> (URI -> [Either (Either GHCupInfo SetupInfo) URI])
-> URI
-> URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Either GHCupInfo SetupInfo) URI
-> [Either (Either GHCupInfo SetupInfo) URI]
-> [Either (Either GHCupInfo SetupInfo) URI]
forall a. a -> [a] -> [a]
:[]) (Either (Either GHCupInfo SetupInfo) URI
 -> [Either (Either GHCupInfo SetupInfo) URI])
-> (URI -> Either (Either GHCupInfo SetupInfo) URI)
-> URI
-> [Either (Either GHCupInfo SetupInfo) URI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Either (Either GHCupInfo SetupInfo) URI
forall a b. b -> Either a b
Right) (Either String URI -> Either String URLSource)
-> (String -> Either String URI)
-> String
-> Either String URLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URIParseError -> String)
-> Either URIParseError URI -> Either String URI
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first URIParseError -> String
forall a. Show a => a -> String
show (Either URIParseError URI -> Either String URI)
-> (String -> Either URIParseError URI)
-> String
-> Either String URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either URIParseError URI
parseURI (ByteString -> Either URIParseError URI)
-> (String -> ByteString) -> String -> Either URIParseError URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString (String -> Either String URLSource)
-> String -> Either String URLSource
forall a b. (a -> b) -> a -> b
$ String
s')

parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource String
"GHCupURL" = NewURLSource -> Either String NewURLSource
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewURLSource
NewGHCupURL
parseNewUrlSource String
"StackSetupURL" = NewURLSource -> Either String NewURLSource
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewURLSource
NewStackSetupURL
parseNewUrlSource String
s' = ((ChannelAlias -> NewURLSource)
-> Either String ChannelAlias -> Either String NewURLSource
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChannelAlias -> NewURLSource
NewChannelAlias (Either String ChannelAlias -> Either String NewURLSource)
-> (String -> Either String ChannelAlias)
-> String
-> Either String NewURLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ChannelAlias
parseChannelAlias (String -> Either String NewURLSource)
-> String -> Either String NewURLSource
forall a b. (a -> b) -> a -> b
$ String
s')
            Either String NewURLSource
-> Either String NewURLSource -> Either String NewURLSource
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Either String NewURLSource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String NewURLSource)
-> (String -> ByteString) -> String -> Either String NewURLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LT.pack (String -> Either String NewURLSource)
-> String -> Either String NewURLSource
forall a b. (a -> b) -> a -> b
$ String
s')
            Either String NewURLSource
-> Either String NewURLSource -> Either String NewURLSource
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((URI -> NewURLSource)
-> Either String URI -> Either String NewURLSource
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URI -> NewURLSource
NewURI (Either String URI -> Either String NewURLSource)
-> (String -> Either String URI)
-> String
-> Either String NewURLSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URIParseError -> String)
-> Either URIParseError URI -> Either String URI
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first URIParseError -> String
forall a. Show a => a -> String
show (Either URIParseError URI -> Either String URI)
-> (String -> Either URIParseError URI)
-> String
-> Either String URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either URIParseError URI
parseURI (ByteString -> Either URIParseError URI)
-> (String -> ByteString) -> String -> Either URIParseError URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString (String -> Either String NewURLSource)
-> String -> Either String NewURLSource
forall a b. (a -> b) -> a -> b
$ String
s')

parseNewUrlSources :: String -> Either String [NewURLSource]
parseNewUrlSources :: String -> Either String [NewURLSource]
parseNewUrlSources String
s = case Parser [ByteString] -> ByteString -> Either String [ByteString]
forall a. Parser a -> ByteString -> Either String a
AP.parseOnly
                              (Parser [ByteString]
AP.parseList' Parser [ByteString] -> Parser ByteString () -> Parser [ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
AP.skipSpaces Parser [ByteString] -> Parser ByteString () -> Parser [ByteString]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
AP.endOfInput)
                              (String -> ByteString
UTF8.fromString String
s) of
  Right [ByteString]
bs ->
    [ByteString]
-> (ByteString -> Either String NewURLSource)
-> Either String [NewURLSource]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ByteString]
bs ((ByteString -> Either String NewURLSource)
 -> Either String [NewURLSource])
-> (ByteString -> Either String NewURLSource)
-> Either String [NewURLSource]
forall a b. (a -> b) -> a -> b
$ \ByteString
b -> Parser NewURLSource -> ByteString -> Either String NewURLSource
forall a. Parser a -> ByteString -> Either String a
AP.parseOnly (Parser NewURLSource
parse Parser NewURLSource -> Parser ByteString () -> Parser NewURLSource
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
AP.skipSpaces Parser NewURLSource -> Parser ByteString () -> Parser NewURLSource
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
AP.endOfInput) ByteString
b
  Left  String
e -> String -> Either String [NewURLSource]
forall a b. a -> Either a b
Left String
e
 where
  parse :: AP.Parser NewURLSource
  parse :: Parser NewURLSource
parse = (NewURLSource
NewGHCupURL NewURLSource -> Parser ByteString ByteString -> Parser NewURLSource
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"GHCupURL")
      Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NewURLSource
NewStackSetupURL NewURLSource -> Parser ByteString ByteString -> Parser NewURLSource
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"StackSetupURL")
      Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Parser NewURLSource] -> Parser NewURLSource
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AP.choice ((\ChannelAlias
x -> ByteString -> Parser ByteString ByteString
AP.string (String -> ByteString
UTF8.fromString (String -> ByteString)
-> (ChannelAlias -> String) -> ChannelAlias -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (ChannelAlias -> Text) -> ChannelAlias -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelAlias -> Text
channelAliasText (ChannelAlias -> ByteString) -> ChannelAlias -> ByteString
forall a b. (a -> b) -> a -> b
$ ChannelAlias
x) Parser ByteString ByteString -> NewURLSource -> Parser NewURLSource
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChannelAlias -> NewURLSource
NewChannelAlias ChannelAlias
x) (ChannelAlias -> Parser NewURLSource)
-> [ChannelAlias] -> [Parser NewURLSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ChannelAlias
forall a. Bounded a => a
minBound..ChannelAlias
forall a. Bounded a => a
maxBound] :: [ChannelAlias]))
      Parser NewURLSource -> Parser NewURLSource -> Parser NewURLSource
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (URI -> NewURLSource
NewURI (URI -> NewURLSource)
-> Parser ByteString URI -> Parser NewURLSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString URI
parseURIP)

parseChannelAlias :: String -> Either String ChannelAlias
parseChannelAlias :: String -> Either String ChannelAlias
parseChannelAlias String
s =
  let aliases :: [(String, ChannelAlias)]
aliases = (ChannelAlias -> (String, ChannelAlias))
-> [ChannelAlias] -> [(String, ChannelAlias)]
forall a b. (a -> b) -> [a] -> [b]
map (\ChannelAlias
c -> (Text -> String
T.unpack (ChannelAlias -> Text
channelAliasText ChannelAlias
c), ChannelAlias
c)) [ChannelAlias
forall a. Bounded a => a
minBound..ChannelAlias
forall a. Bounded a => a
maxBound]
  in case String -> [(String, ChannelAlias)] -> Maybe ChannelAlias
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, ChannelAlias)]
aliases of
    Just ChannelAlias
c -> ChannelAlias -> Either String ChannelAlias
forall a b. b -> Either a b
Right ChannelAlias
c
    Maybe ChannelAlias
Nothing -> String -> Either String ChannelAlias
forall a b. a -> Either a b
Left (String -> Either String ChannelAlias)
-> String -> Either String ChannelAlias
forall a b. (a -> b) -> a -> b
$ String
"Unexpected ChannelAlias: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

#if MIN_VERSION_transformers(0,6,0)
instance Alternative (Either [a]) where
    empty :: forall a. Either [a] a
empty        = [a] -> Either [a] a
forall a b. a -> Either a b
Left []
    Left [a]
_ <|> :: forall a. Either [a] a -> Either [a] a -> Either [a] a
<|> Either [a] a
n = Either [a] a
n
    Either [a] a
m      <|> Either [a] a
_ = Either [a] a
m
#endif