Parse 'installed' constraints

Cabal constraints, like those returned from stackage's cabal.config
endpoint, can specify packages in a number of ways, including
e.g. 'mtl installed'. Previously we were ignoring such constraints.

We now parse these too.

Author: tbidne

clc-stackage.cabal

@@ -35,15 +35,18 @@ library utils
     CLC.Stackage.Utils.JSON
     CLC.Stackage.Utils.Logging
     CLC.Stackage.Utils.OS
+    CLC.Stackage.Utils.Package
     CLC.Stackage.Utils.Paths
 
   build-depends:
     , aeson            >=2.0       && <2.3
     , aeson-pretty     ^>=0.8.9
     , bytestring       >=0.10.12.0 && <0.13
+    , deepseq          >=1.4.6.0   && <1.6
     , directory        ^>=1.3.5.0
     , file-io          ^>=0.1.0.0
     , filepath         >=1.4.100.0 && <1.6
+    , megaparsec       >=9.5.0     && <9.8
     , pretty-terminal  ^>=0.1.0.0
     , text             >=1.2.3.2   && <2.2
     , time             >=1.9.3     && <1.15
@@ -63,11 +66,12 @@ library parser
     , aeson
     , bytestring
     , containers       >=0.6.3.1 && <0.9
-    , deepseq          >=1.4.6.0 && <1.6
+    , deepseq
     , filepath
     , http-client      >=0.5.9   && <0.8
     , http-client-tls  ^>=0.3
     , http-types       ^>=0.12.3
+    , megaparsec
     , text
     , utils
 
@@ -79,12 +83,10 @@ library builder
     CLC.Stackage.Builder
     CLC.Stackage.Builder.Batch
     CLC.Stackage.Builder.Env
-    CLC.Stackage.Builder.Package
     CLC.Stackage.Builder.Process
     CLC.Stackage.Builder.Writer
 
   build-depends:
-    , aeson
     , containers
     , directory
     , filepath
@@ -146,6 +148,7 @@ test-suite unit
     Unit.CLC.Stackage.Parser.API
     Unit.CLC.Stackage.Runner.Env
     Unit.CLC.Stackage.Runner.Report
+    Unit.CLC.Stackage.Utils.Package
     Unit.Prelude
 
   build-depends:

src/builder/CLC/Stackage/Builder/Batch.hs

@@ -10,7 +10,7 @@ import CLC.Stackage.Builder.Env
         packagesToBuild
       ),
   )
-import CLC.Stackage.Builder.Package (Package)
+import CLC.Stackage.Utils.Package (Package)
 import Data.Bifunctor (Bifunctor (first))
 import Data.List qualified as L
 import Data.List.NonEmpty (NonEmpty ((:|)), (<|))

src/builder/CLC/Stackage/Builder/Env.hs

@@ -6,8 +6,8 @@ module CLC.Stackage.Builder.Env
   )
 where
 
-import CLC.Stackage.Builder.Package (Package)
 import CLC.Stackage.Utils.Logging qualified as Logging
+import CLC.Stackage.Utils.Package (Package)
 import Data.IORef (IORef)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Set (Set)

src/builder/CLC/Stackage/Builder/Package.hs

@@ -18,10 +18,10 @@ import CLC.Stackage.Builder.Env
     WriteLogs (WriteLogsCurrent, WriteLogsNone, WriteLogsSaveFailures),
   )
 import CLC.Stackage.Builder.Env qualified as Env
-import CLC.Stackage.Builder.Package qualified as Package
 import CLC.Stackage.Builder.Writer qualified as Writer
 import CLC.Stackage.Utils.IO qualified as IO
 import CLC.Stackage.Utils.Logging qualified as Logging
+import CLC.Stackage.Utils.Package qualified as Package
 import CLC.Stackage.Utils.Paths qualified as Paths
 import Control.Exception (throwIO)
 import Control.Monad (when)
@@ -115,7 +115,7 @@ buildProject env idx pkgs = do
       mconcat
         [ T.pack $ show idx,
           ": ",
-          T.intercalate ", " (Package.toText <$> pkgsList)
+          T.intercalate ", " (Package.toTextInstalled <$> pkgsList)
         ]
     pkgsList = NE.toList pkgs.unPackageGroup
     pkgsSet = Set.fromList pkgsList

src/builder/CLC/Stackage/Builder/Process.hs

@@ -5,9 +5,9 @@ module CLC.Stackage.Builder.Writer
 where
 
 import CLC.Stackage.Builder.Batch (PackageGroup (unPackageGroup))
-import CLC.Stackage.Builder.Package (Package)
-import CLC.Stackage.Builder.Package qualified as Package
 import CLC.Stackage.Utils.IO qualified as IO
+import CLC.Stackage.Utils.Package (Package)
+import CLC.Stackage.Utils.Package qualified as Package
 import CLC.Stackage.Utils.Paths qualified as Paths
 import Data.List.NonEmpty qualified as NE
 import Data.Text (Text)
@@ -33,7 +33,7 @@ writeCabalProjectLocal pkgs = IO.writeBinaryFile path constraintsSrc
     path = Paths.generatedCabalProjectLocalPath
     constraintsSrc = TEnc.encodeUtf8 constraintsTxt
     constraintsTxt = T.unlines $ "constraints:" : constraints
-    constraints = (\p -> "  " <> Package.toText p <> ",") <$> pkgs
+    constraints = (\p -> "  " <> Package.toCabalConstraintsText p) <$> pkgs
 
 -- | Writes the package set to a cabal file for building. This will be called
 -- for each group we want to build.
@@ -60,7 +60,7 @@ mkCabalFile pkgs =
            "    default-language: Haskell2010"
          ]
   where
-    pkgsTxt = (\p -> pkgsIndent <> Package.toDepText p) <$> NE.toList pkgs.unPackageGroup
+    pkgsTxt = (\p -> pkgsIndent <> Package.toCabalDepText p) <$> NE.toList pkgs.unPackageGroup
 
 -- build-depends is indented 4, then 2 for the package itself.
 pkgsIndent :: Text

src/builder/CLC/Stackage/Builder/Writer.hs

@@ -11,8 +11,7 @@ module CLC.Stackage.Parser
 where
 
 import CLC.Stackage.Parser.API
-  ( PackageResponse (name, version),
-    StackageResponse (packages),
+  ( StackageResponse (packages),
   )
 import CLC.Stackage.Parser.API qualified as API
 import CLC.Stackage.Parser.API.CabalConfig qualified as CabalConfig
@@ -21,6 +20,8 @@ import CLC.Stackage.Utils.JSON qualified as JSON
 import CLC.Stackage.Utils.Logging qualified as Logging
 import CLC.Stackage.Utils.OS (Os (Linux, Osx, Windows))
 import CLC.Stackage.Utils.OS qualified as OS
+import CLC.Stackage.Utils.Package (Package)
+import CLC.Stackage.Utils.Package qualified as Package
 import Control.Monad (when)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Foldable (for_)
@@ -33,13 +34,13 @@ import System.OsPath (OsPath, osp)
 
 -- | Retrieves the list of packages, based on
 -- 'CLC.Stackage.Parser.API.stackageUrl'.
-getPackageList :: Logging.Handle -> Maybe OsPath -> IO [PackageResponse]
+getPackageList :: Logging.Handle -> Maybe OsPath -> IO [Package]
 getPackageList hLogger msnapshotPath =
   getPackageListByOs hLogger msnapshotPath OS.currentOs
 
 -- | Prints the package list to a file.
-printPackageList :: Bool -> Maybe Os -> IO ()
-printPackageList incVers mOs = do
+printPackageList :: Maybe Os -> IO ()
+printPackageList mOs = do
   case mOs of
     Just os -> printOsList os
     Nothing -> for_ [minBound .. maxBound] printOsList
@@ -49,23 +50,18 @@ printPackageList incVers mOs = do
     file Windows = [osp|pkgs_windows.txt|]
 
     printOsList os = do
-      pkgs <- getPackageListByOsFmt incVers os
+      pkgs <- getPackageListByOsFmt os
       let txt = T.unlines pkgs
       IO.writeFileUtf8 (file os) txt
 
 -- | Retrieves the package list formatted to text.
-getPackageListByOsFmt :: Bool -> Os -> IO [Text]
-getPackageListByOsFmt incVers =
-  (fmap . fmap) toText
+getPackageListByOsFmt :: Os -> IO [Text]
+getPackageListByOsFmt =
+  (fmap . fmap) Package.toTextInstalled
     . getPackageListByOs Logging.mkDefaultLogger Nothing
-  where
-    toText r =
-      if incVers
-        then r.name <> "-" <> r.version
-        else r.name
 
 -- | Helper in case we want to see what the package set for a given OS is.
-getPackageListByOs :: Logging.Handle -> Maybe OsPath -> Os -> IO [PackageResponse]
+getPackageListByOs :: Logging.Handle -> Maybe OsPath -> Os -> IO [Package]
 getPackageListByOs hLogger msnapshotPath os = do
   excludedPkgs <- getExcludedPkgs os
   let filterExcluded = flip Set.notMember excludedPkgs . (.name)

src/parser/CLC/Stackage/Parser.hs

@@ -2,7 +2,6 @@
 module CLC.Stackage.Parser.API
   ( -- * Querying stackage
     StackageResponse (..),
-    PackageResponse (..),
     getStackage,
 
     -- ** Exceptions
@@ -22,7 +21,6 @@ import CLC.Stackage.Parser.API.Common
         ReasonReadBody,
         ReasonStatus
       ),
-    PackageResponse (name, version),
     StackageException (MkStackageException),
     StackageResponse (MkStackageResponse, packages),
   )

src/parser/CLC/Stackage/Parser/API.hs

@@ -13,25 +13,22 @@ import CLC.Stackage.Parser.API.Common
         ReasonReadBody,
         ReasonStatus
       ),
-    PackageResponse
-      ( MkPackageResponse,
-        name,
-        version
-      ),
     StackageException (MkStackageException),
     StackageResponse (MkStackageResponse),
     getStatusCode,
   )
 import CLC.Stackage.Utils.Exception qualified as Ex
+import CLC.Stackage.Utils.Package qualified as Package
 import Control.Exception (throwIO)
 import Control.Monad (when)
-import Data.List qualified as L
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TEnc
 import Network.HTTP.Client (BodyReader, Manager, Request, Response)
 import Network.HTTP.Client qualified as HttpClient
+import Text.Megaparsec qualified as MP
+import Text.Megaparsec.Char qualified as MPC
 
 -- | Given http manager and snapshot string, queries the cabal config
 -- endpoint. This is intended as a backup, for when the primary endpoint fails.
@@ -80,45 +77,13 @@ parseCabalConfig =
     . fmap parseCabalConfigLine
     . T.lines
 
--- | Parses a line like '<pkg> ==<vers>'. This does not currently handle
--- "installed" packages e.g. 'mtl installed'. This probably isn't a big deal,
--- since all such libs will be built transitively anyway. That said, if
--- we wanted to fix it, we would probably want to change PackageResponse's
---
---   version :: Text
---
--- field to
---
---   version :: Maybe Text
---
--- and parse "installed" to Nothing. Then, when we go to write the generated
--- cabal file, Nothing will correspond to writing no version number.
--- (CLC.Stackage.Builder.Package.toText).
-parseCabalConfigLine :: Text -> Maybe PackageResponse
--- splitOn rather than breakOn since the former drops the delim, which is
--- convenient.
-parseCabalConfigLine txt = case T.splitOn delim txt of
-  [nameRaw, versRaw] -> do
-    (v, c) <- T.unsnoc versRaw
-    -- Strip trailing comma if it exists. Otherwise take everything.
-    let version = if c == ',' then v else T.snoc v c
-
-    -- This line handles prefixes e.g. whitespace or a stanza e.g.
-    --
-    --     constraints: abstract-deque ==0.3,
-    --                  abstract-deque-tests ==0.3,
-    --                  ...
-    --
-    -- We split pre-delim on whitespace, and take the last word.
-    (_, name) <- L.unsnoc $ T.words nameRaw
-
-    -- T.strip as trailing characters can cause problems e.g. windows can
-    -- pick up \r.
-    Just $
-      MkPackageResponse
-        { name = T.strip name,
-          version = T.strip version
-        }
-  _ -> Nothing
+-- | Parses a line like '<pkg> ==<vers>'.
+parseCabalConfigLine :: Text -> Maybe Package.Package
+parseCabalConfigLine txt = case MP.parse (MPC.space *> p) "package" txt of
+  Right x -> Just x
+  Left _ -> Nothing
   where
-    delim = " =="
+    -- Optional case for leading constraints section.
+    p = do
+      _ <- MP.optional (MPC.string "constraints:" *> MPC.space)
+      Package.packageParser

src/parser/CLC/Stackage/Parser/API/CabalConfig.hs

@@ -2,7 +2,6 @@
 module CLC.Stackage.Parser.API.Common
   ( -- * Types
     StackageResponse (..),
-    PackageResponse (..),
 
     -- * Exception
     StackageException (..),
@@ -13,13 +12,13 @@ module CLC.Stackage.Parser.API.Common
   )
 where
 
+import CLC.Stackage.Utils.Package (Package)
 import Control.DeepSeq (NFData)
 import Control.Exception
   ( Exception (displayException),
     SomeException,
   )
 import Data.ByteString (ByteString)
-import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException)
 import GHC.Generics (Generic)
 import Network.HTTP.Client (Response)
@@ -29,15 +28,7 @@ import Network.HTTP.Types.Status qualified as Status
 
 -- | Stackage response. This type unifies different stackage responses.
 newtype StackageResponse = MkStackageResponse
-  { packages :: [PackageResponse]
-  }
-  deriving stock (Eq, Generic, Show)
-  deriving anyclass (NFData)
-
--- | Package in a stackage snapshot.
-data PackageResponse = MkPackageResponse
-  { name :: Text,
-    version :: Text
+  { packages :: [Package]
   }
   deriving stock (Eq, Generic, Show)
   deriving anyclass (NFData)