From 826900cc416d972bf00de3b3d16e89fc5fe9b373 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 22 Jul 2020 01:08:58 +0200 Subject: [PATCH] Improve documentation --- lib/GHCup.hs | 113 ++++++++++++++++++++--------- lib/GHCup/Data/GHCupDownloads.hs | 12 +++ lib/GHCup/Data/GHCupInfo.hs | 9 +++ lib/GHCup/Data/ToolRequirements.hs | 9 +++ lib/GHCup/Download.hs | 17 +++++ lib/GHCup/Errors.hs | 9 +++ lib/GHCup/Platform.hs | 9 +++ lib/GHCup/Requirements.hs | 9 +++ lib/GHCup/Types.hs | 9 +++ lib/GHCup/Types/JSON.hs | 9 +++ lib/GHCup/Types/Optics.hs | 9 +++ lib/GHCup/Utils.hs | 35 +++++++-- lib/GHCup/Utils/Dirs.hs | 9 +++ lib/GHCup/Utils/File.hs | 12 +++ lib/GHCup/Utils/Logger.hs | 11 +++ lib/GHCup/Utils/MegaParsec.hs | 9 +++ lib/GHCup/Utils/Prelude.hs | 11 +++ lib/GHCup/Utils/String/QQ.hs | 50 ++++++++----- lib/GHCup/Utils/Version/QQ.hs | 9 +++ lib/GHCup/Version.hs | 11 +++ 20 files changed, 308 insertions(+), 63 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 6f9f9b8..5fcb7f4 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -11,6 +11,21 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-| +Module : GHCup +Description : GHCup installation functions +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +This module contains the main functions that correspond +to the command line interface, like installation, listing versions +and so on. + +These are the entry points. +-} module GHCup where @@ -76,32 +91,33 @@ import qualified Data.Text.Encoding as E ------------------------- - +-- | Like 'installGHCBin', except takes the 'DownloadInfo' as +-- argument instead of looking it up from 'GHCupDownloads'. installGHCBindist :: ( MonadFail m - , MonadMask m - , MonadCatch m - , MonadReader Settings m - , MonadLogger m - , MonadResource m - , MonadIO m - ) - => DownloadInfo - -> Version - -> PlatformRequest - -> Excepts - '[ AlreadyInstalled - , BuildFailed - , DigestError - , DownloadFailed - , NoDownload - , NotInstalled - , UnknownArchive + , MonadMask m + , MonadCatch m + , MonadReader Settings m + , MonadLogger m + , MonadResource m + , MonadIO m + ) + => DownloadInfo -- ^ where/how to download + -> Version -- ^ the version to install + -> PlatformRequest -- ^ the platform to install on + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive #if !defined(TAR) - , ArchiveResult + , ArchiveResult #endif - ] - m - () + ] + m + () installGHCBindist dlinfo ver (PlatformRequest {..}) = do let tver = (mkTVer ver) lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] @@ -149,6 +165,11 @@ installGHCBindist dlinfo ver (PlatformRequest {..}) = do | otherwise = [] +-- | Installs GHC into @~\/.ghcup\/ghc/\@ and places the +-- following symlinks in @~\/.ghcup\/bin@: +-- +-- * @ghc-x.y.z -> ..\/ghc\/x.y.z\/bin/ghc@ +-- * @ghc-x.y -> ..\/ghc\/x.y.z\/bin/ghc@ (if x.y.z is the latest x.y version) installGHCBin :: ( MonadFail m , MonadMask m , MonadCatch m @@ -157,9 +178,9 @@ installGHCBin :: ( MonadFail m , MonadResource m , MonadIO m ) - => GHCupDownloads - -> Version - -> PlatformRequest + => GHCupDownloads -- ^ the download info to look up the tarball from + -> Version -- ^ the version to install + -> PlatformRequest -- ^ the platform to install on -> Excepts '[ AlreadyInstalled , BuildFailed @@ -179,6 +200,8 @@ installGHCBin bDls ver pfreq = do installGHCBindist dlinfo ver pfreq +-- | Like 'installCabalBin', except takes the 'DownloadInfo' as +-- argument instead of looking it up from 'GHCupDownloads'. installCabalBindist :: ( MonadMask m , MonadCatch m , MonadReader Settings m @@ -255,6 +278,9 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do Overwrite +-- | Installs cabal into @~\/.ghcup\/bin/cabal-\ and +-- creates a default @cabal -> cabal-x.y.z.q@ symlink for +-- the latest installed version. installCabalBin :: ( MonadMask m , MonadCatch m , MonadReader Settings m @@ -293,15 +319,15 @@ installCabalBin bDls ver pfreq = do --- | Set GHC symlinks in ~/.ghcup/bin for the requested GHC version. The behavior depends +-- | Set GHC symlinks in @~\/.ghcup\/bin@ for the requested GHC version. The behavior depends -- on `SetGHC`: -- --- * SetGHCOnly: ~/.ghcup/bin/ghc -> ~/.ghcup/ghc//bin/ghc --- * SetGHC_XY: ~/.ghcup/bin/ghc-X.Y -> ~/.ghcup/ghc//bin/ghc --- * SetGHC_XYZ: ~/.ghcup/bin/ghc- -> ~/.ghcup/ghc//bin/ghc +-- * SetGHCOnly: @~\/.ghcup\/bin\/ghc -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ +-- * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ +-- * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\ -> ~\/.ghcup\/ghc\/\\/bin\/ghc@ -- --- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc//share symlink --- for `SetGHCOnly` constructor. +-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\\/share symlink@ +-- for 'SetGHCOnly' constructor. setGHC :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) => GHCTargetVersion -> SetGHC @@ -366,7 +392,7 @@ setGHC ver sghc = do --- | Set the ~/.ghcup/bin/cabal symlink. +-- | Set the @~\/.ghcup\/bin\/cabal@ symlink. setCabal :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) => Version -> Excepts '[NotInstalled] m () @@ -406,10 +432,13 @@ setCabal ver = do ------------------ +-- | Filter data type for 'listVersions'. data ListCriteria = ListInstalled | ListSet deriving Show +-- | A list result describes a single tool version +-- and various of its properties. data ListResult = ListResult { lTool :: Tool , lVer :: Version @@ -424,6 +453,7 @@ data ListResult = ListResult deriving (Eq, Ord, Show) +-- | Extract all available tool versions and their tags. availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag] availableToolVersions av tool = view (at tool % non Map.empty % to (fmap (_viTags))) @@ -552,7 +582,11 @@ listVersions av lt criteria pfreq = do -------------------- --- | This function may throw and crash in various ways. +-- | Delete a ghc version and all its symlinks. +-- +-- This may leave GHCup without a "set" version. +-- Will try to fix the ghc-x.y symlink after removal (e.g. to an +-- older version). rmGHCVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m) => GHCTargetVersion -> Excepts '[NotInstalled] m () @@ -591,7 +625,8 @@ rmGHCVer ver = do else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)) --- | This function may throw and crash in various ways. +-- | Delete a cabal version. Will try to fix the @cabal@ symlink +-- after removal (e.g. setting it to an older version). rmCabalVer :: (MonadThrow m, MonadLogger m, MonadIO m, MonadFail m) => Version -> Excepts '[NotInstalled] m () @@ -640,6 +675,8 @@ getDebugInfo = do --------------- +-- | Compile a GHC from sourc. This behaves wrt symlinks and installation +-- the same as 'installGHCBin'. compileGHC :: ( MonadMask m , MonadReader Settings m , MonadThrow m @@ -821,6 +858,8 @@ Stage1Only = YES|] +-- | Compile a cabal from sourc. This behaves wrt symlinks and installation +-- the same as 'installCabalBin'. compileCabal :: ( MonadReader Settings m , MonadResource m , MonadMask m @@ -940,6 +979,8 @@ compileCabal dls tver bghc jobs patchdir PlatformRequest{..} = do --------------------- +-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@, +-- if no path is provided. upgradeGHCup :: ( MonadMask m , MonadReader Settings m , MonadCatch m @@ -991,7 +1032,7 @@ upgradeGHCup dls mtarget force pfreq = do ------------- --- | Creates ghc-x.y.z and ghc-x.y symlinks. This is used for +-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for -- both installing from source and bindist. postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) => GHCTargetVersion diff --git a/lib/GHCup/Data/GHCupDownloads.hs b/lib/GHCup/Data/GHCupDownloads.hs index f197861..3f38e8e 100644 --- a/lib/GHCup/Data/GHCupDownloads.hs +++ b/lib/GHCup/Data/GHCupDownloads.hs @@ -2,6 +2,18 @@ {-# LANGUAGE QuasiQuotes #-} +{-| +Module : GHCup.Data.GHCupDownloads +Description : Download information +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +This is the module to add additional ghc/cabal etc. versions, +fix URLs, add tags, etc. +-} module GHCup.Data.GHCupDownloads ( ghcupDownloads ) diff --git a/lib/GHCup/Data/GHCupInfo.hs b/lib/GHCup/Data/GHCupInfo.hs index 3cd792d..ac2c15c 100644 --- a/lib/GHCup/Data/GHCupInfo.hs +++ b/lib/GHCup/Data/GHCupInfo.hs @@ -1,3 +1,12 @@ +{-| +Module : GHCup.Data.GHCupInfo +Description : +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Data.GHCupInfo where import GHCup.Data.GHCupDownloads diff --git a/lib/GHCup/Data/ToolRequirements.hs b/lib/GHCup/Data/ToolRequirements.hs index f922a16..3ad4000 100644 --- a/lib/GHCup/Data/ToolRequirements.hs +++ b/lib/GHCup/Data/ToolRequirements.hs @@ -1,6 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-| +Module : GHCup.Data.ToolRequirements +Description : Tool requirements +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Data.ToolRequirements where import GHCup.Types diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 9ea86f9..bf03d5e 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -9,6 +9,23 @@ {-# LANGUAGE TypeFamilies #-} +{-| +Module : GHCup.Download +Description : Downloading +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +Module for handling all download related functions. + +Generally we support downloading via: + + - curl (default) + - wget + - internal downloader (only when compiled) +-} module GHCup.Download where #if defined(INTERNAL_DOWNLOADER) diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index d963de8..4108121 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -3,6 +3,15 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DataKinds #-} +{-| +Module : GHCup.Errors +Description : GHCup error types +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Errors where import GHCup.Types diff --git a/lib/GHCup/Platform.hs b/lib/GHCup/Platform.hs index 1ccbd46..6f69eef 100644 --- a/lib/GHCup/Platform.hs +++ b/lib/GHCup/Platform.hs @@ -6,6 +6,15 @@ {-# LANGUAGE TemplateHaskell #-} +{-| +Module : GHCup.Plaform +Description : Retrieving platform information +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Platform where diff --git a/lib/GHCup/Requirements.hs b/lib/GHCup/Requirements.hs index d550609..24f4761 100644 --- a/lib/GHCup/Requirements.hs +++ b/lib/GHCup/Requirements.hs @@ -1,5 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} +{-| +Module : GHCup.Requirements +Description : Requirements utilities +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Requirements where import GHCup.Types diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index 5e2a7b2..df6a8e5 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -2,6 +2,15 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +{-| +Module : GHCup.Types +Description : GHCup types +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Types where import Data.Map.Strict ( Map ) diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index b1e52d6..c87e33d 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -10,6 +10,15 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-| +Module : GHCup.Types.JSON +Description : GHCup JSON types/instances +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Types.JSON where import GHCup.Types diff --git a/lib/GHCup/Types/Optics.hs b/lib/GHCup/Types/Optics.hs index 9795196..5fb344e 100644 --- a/lib/GHCup/Types/Optics.hs +++ b/lib/GHCup/Types/Optics.hs @@ -1,5 +1,14 @@ {-# LANGUAGE TemplateHaskell #-} +{-| +Module : GHCup.Types.Optics +Description : GHCup optics +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Types.Optics where import GHCup.Types diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 39e22a2..0f04867 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -6,7 +6,18 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} +{-| +Module : GHCup.Utils +Description : GHCup domain specific utilities +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +This module contains GHCup helpers specific to +installation and introspection of files/versions etc. +-} module GHCup.Utils ( module GHCup.Utils.Dirs , module GHCup.Utils @@ -93,7 +104,7 @@ ghcLinkDestination tool ver = "../ghc/" <> E.encodeUtf8 (prettyTVer ver) <> "/bin/" <> tool --- e.g. ghc-8.6.5 +-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5. rmMinorSymlinks :: (MonadIO m, MonadLogger m) => GHCTargetVersion -> m () rmMinorSymlinks GHCTargetVersion {..} = do bindir <- liftIO $ ghcupBinDir @@ -112,7 +123,7 @@ rmMinorSymlinks GHCTargetVersion {..} = do liftIO $ hideError doesNotExistErrorType $ deleteFile fullF --- Removes the set ghc version for the given target, if any. +-- | Removes the set ghc version for the given target, if any. rmPlain :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) => Maybe Text -- ^ target -> Excepts '[NotInstalled] m () @@ -131,7 +142,7 @@ rmPlain target = do liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file --- e.g. ghc-8.6 +-- | Remove the major GHC symlink, e.g. ghc-8.6. rmMajorSymlinks :: (MonadThrow m, MonadLogger m, MonadIO m) => GHCTargetVersion -> m () @@ -162,18 +173,21 @@ rmMajorSymlinks GHCTargetVersion {..} = do ----------------------------------- +-- | Whethe the given GHC versin is installed. ghcInstalled :: GHCTargetVersion -> IO Bool ghcInstalled ver = do ghcdir <- ghcupGHCDir ver doesDirectoryExist ghcdir +-- | Whether the given GHC version is installed from source. ghcSrcInstalled :: GHCTargetVersion -> IO Bool ghcSrcInstalled ver = do ghcdir <- ghcupGHCDir ver doesFileExist (ghcdir ghcUpSrcBuiltFile) +-- | Whether the given GHC version is set as the current. ghcSet :: (MonadThrow m, MonadIO m) => Maybe Text -- ^ the target of the GHC version, if any -- (e.g. armv7-unknown-linux-gnueabihf) @@ -219,6 +233,7 @@ getInstalledGHCs = do Left _ -> pure $ Left f +-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. getInstalledCabals :: IO [Either (Path Rel) Version] getInstalledCabals = do bindir <- liftIO $ ghcupBinDir @@ -233,12 +248,14 @@ getInstalledCabals = do pure $ maybe vs (\x -> Right x:vs) cs +-- | Whether the given cabal version is installed. cabalInstalled :: Version -> IO Bool cabalInstalled ver = do vers <- fmap rights $ getInstalledCabals pure $ elem ver $ vers +-- Return the currently set cabal version, if any. cabalSet :: (MonadIO m, MonadThrow m) => m (Maybe Version) cabalSet = do cabalbin <- ( [rel|cabal|]) <$> liftIO ghcupBinDir @@ -257,11 +274,13 @@ cabalSet = do + ----------------------------------------- --[ Major version introspection (X.Y) ]-- ----------------------------------------- +-- | Extract (major, minor) from any version. getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) getMajorMinorV Version {..} = case _vChunks of ([Digits x] : [Digits y] : _) -> pure (fromIntegral x, fromIntegral y) @@ -415,11 +434,12 @@ urlBaseName :: MonadThrow m urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False --- Get tool files from '~/.ghcup/bin/ghc//bin/*' --- while ignoring *- symlinks and accounting for cross triple prefix. +-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\\/bin\/\*@ +-- while ignoring @*-\@ symlinks and accounting for cross triple prefix. -- -- Returns unversioned relative files, e.g.: --- ["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"] +-- +-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@ ghcToolFiles :: (MonadThrow m, MonadFail m, MonadIO m) => GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel] @@ -466,7 +486,7 @@ ghcToolFiles ver = do isHadrian = fmap (/= SymbolicLink) . getFileType --- | This file, when residing in ~/.ghcup/ghc// signals that +-- | This file, when residing in @~\/.ghcup\/ghc\/\\/@ signals that -- this GHC was built from source. It contains the build config. ghcUpSrcBuiltFile :: Path Rel ghcUpSrcBuiltFile = [rel|.ghcup_src_built|] @@ -504,6 +524,7 @@ applyPatches pdir ddir = do !? PatchFailed +-- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353 darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ()) darwinNotarization Darwin path = exec "xattr" diff --git a/lib/GHCup/Utils/Dirs.hs b/lib/GHCup/Utils/Dirs.hs index 7f19b99..f3c0b12 100644 --- a/lib/GHCup/Utils/Dirs.hs +++ b/lib/GHCup/Utils/Dirs.hs @@ -2,6 +2,15 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ViewPatterns #-} +{-| +Module : GHCup.Utils.Dirs +Description : Definition of GHCup directories +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Utils.Dirs where diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs index bdf7cc9..eec8362 100644 --- a/lib/GHCup/Utils/File.hs +++ b/lib/GHCup/Utils/File.hs @@ -3,6 +3,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} +{-| +Module : GHCup.Utils.File +Description : File and unix APIs +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +This module handles file and executable handling. +Some of these functions use sophisticated logging. +-} module GHCup.Utils.File where import GHCup.Utils.Dirs diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs index a586b3a..45f49dc 100644 --- a/lib/GHCup/Utils/Logger.hs +++ b/lib/GHCup/Utils/Logger.hs @@ -1,5 +1,16 @@ {-# LANGUAGE QuasiQuotes #-} +{-| +Module : GHCup.Utils.Logger +Description : logger definition +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +Here we define our main logger. +-} module GHCup.Utils.Logger where import GHCup.Utils diff --git a/lib/GHCup/Utils/MegaParsec.hs b/lib/GHCup/Utils/MegaParsec.hs index c9126fd..d652361 100644 --- a/lib/GHCup/Utils/MegaParsec.hs +++ b/lib/GHCup/Utils/MegaParsec.hs @@ -1,6 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-| +Module : GHCup.Utils.MegaParsec +Description : MegaParsec utilities +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Utils.MegaParsec where import GHCup.Types diff --git a/lib/GHCup/Utils/Prelude.hs b/lib/GHCup/Utils/Prelude.hs index 3eea58a..20fd896 100644 --- a/lib/GHCup/Utils/Prelude.hs +++ b/lib/GHCup/Utils/Prelude.hs @@ -8,6 +8,17 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-| +Module : GHCup.Utils.Prelude +Description : MegaParsec utilities +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +GHCup specific prelude. Lots of Excepts functionality. +-} module GHCup.Utils.Prelude where import Control.Applicative diff --git a/lib/GHCup/Utils/String/QQ.hs b/lib/GHCup/Utils/String/QQ.hs index c0a1d24..6cff357 100644 --- a/lib/GHCup/Utils/String/QQ.hs +++ b/lib/GHCup/Utils/String/QQ.hs @@ -1,25 +1,35 @@ {-# LANGUAGE TemplateHaskell #-} --- | QuasiQuoter for non-interpolated strings, texts and bytestrings. --- --- The "s" quoter contains a multi-line string with no interpolation at all, --- except that the leading newline is trimmed and carriage returns stripped. --- --- @ --- {-\# LANGUAGE QuasiQuotes #-} --- import Data.Text (Text) --- import Data.String.QQ --- foo :: Text -- "String", "ByteString" etc also works --- foo = [s| --- Well here is a --- multi-line string! --- |] --- @ --- --- Any instance of the IsString type is permitted. --- --- (For GHC versions 6, write "[$s||]" instead of "[s||]".) --- +{-| +Module : GHCup.Utils.String.QQ +Description : String quasi quoters +Copyright : (c) Audrey Tang 2019, Julian Ospald 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX + +QuasiQuoter for non-interpolated strings, texts and bytestrings. + +The "s" quoter contains a multi-line string with no interpolation at all, +except that the leading newline is trimmed and carriage returns stripped. + +@ +{-\# LANGUAGE QuasiQuotes #-} +import Data.Text (Text) +import Data.String.QQ +foo :: Text -- "String", "ByteString" etc also works +foo = [s| +Well here is a + multi-line string! +|] +@ + +Any instance of the IsString type is permitted. + +(For GHC versions 6, write "[$s||]" instead of "[s||]".) + +-} module GHCup.Utils.String.QQ ( s ) diff --git a/lib/GHCup/Utils/Version/QQ.hs b/lib/GHCup/Utils/Version/QQ.hs index eef654c..663460e 100644 --- a/lib/GHCup/Utils/Version/QQ.hs +++ b/lib/GHCup/Utils/Version/QQ.hs @@ -7,6 +7,15 @@ {-# LANGUAGE TemplateHaskell #-} +{-| +Module : GHCup.Utils.Version.QQ +Description : Version quasi-quoters +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Utils.Version.QQ where import Data.Data diff --git a/lib/GHCup/Version.hs b/lib/GHCup/Version.hs index da03715..86386b1 100644 --- a/lib/GHCup/Version.hs +++ b/lib/GHCup/Version.hs @@ -1,6 +1,15 @@ {-# LANGUAGE QuasiQuotes #-} +{-| +Module : GHCup.Version +Description : Static version information +Copyright : (c) Julian Ospald, 2020 +License : GPL-3 +Maintainer : hasufell@hasufell.de +Stability : experimental +Portability : POSIX +-} module GHCup.Version where import GHCup.Utils.Version.QQ @@ -15,8 +24,10 @@ import qualified Data.Text as T ghcupURL :: URI ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|] +-- | The curren ghcup version. ghcUpVer :: PVP ghcUpVer = [pver|0.1.8|] +-- | ghcup version as numeric string. numericVer :: String numericVer = T.unpack . prettyPVP $ ghcUpVer