Add support for adding bower packages from branches to package set (#104)

* Add support for adding bower packages from branches to package set

* Exclude separator from version part of package specifier

* Refactor maybeE -> Control.Error.Util.note

* Use Bifunctor.second instead of arrows

* Refactor addFromBower argument parsing

Author: strax

app/Main.hs

@@ -11,6 +11,7 @@ module Main where
 
 import qualified Control.Foldl as Foldl
 import           Control.Concurrent.Async (forConcurrently_, mapConcurrently)
+import           Control.Error.Util (note)
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Types (fieldLabelModifier)
 import           Data.Aeson.Encode.Pretty
@@ -497,7 +498,7 @@ data BowerInfo = BowerInfo
   { bower_name         :: Text
   , bower_repository   :: BowerInfoRepo
   , bower_dependencies :: Map.Map Text Text
-  , bower_version      :: Text
+  , bower_version      :: Maybe Text
   } deriving (Show, Eq, Generic)
 instance Aeson.FromJSON BowerInfo where
   parseJSON = Aeson.genericParseJSON Aeson.defaultOptions
@@ -509,22 +510,25 @@ data BowerOutput = BowerOutput
   } deriving (Show, Eq, Generic, Aeson.FromJSON)
 
 addFromBower :: String -> IO ()
-addFromBower name = do
-  let bowerProc = inproc "bower" [ "info", T.pack name, "--json", "-l=error" ] empty
+addFromBower arg = do
+  echoT $ "Adding package " <> name <> " at " <> (fromMaybe "latest" version) <> " from Bower..."
+  let bowerProc = inproc "bower" [ "info", T.pack arg, "--json", "-l=error" ] empty
   result <- fold <$> shellToIOText bowerProc
   if T.null result
     then exitWithErr "Error: Does the package exist on Bower?"
     else do
       let result' = do
-            bowerOutput <- Aeson.eitherDecodeStrict $ encodeUtf8 result
-            let bowerInfo = latest bowerOutput
+            bowerInfo <- case version of
+              Just _ -> Aeson.eitherDecodeStrict (encodeUtf8 result) :: Either String BowerInfo
+              Nothing -> latest <$> Aeson.eitherDecodeStrict (encodeUtf8 result) :: Either String BowerInfo
+            version' <- note "Unable to infer the package version" $ ("v" <>) <$> bower_version bowerInfo <|> version
             pkgName <- mkPackageName' $ bower_name bowerInfo
             packageNames <- traverse mkPackageName' $ Map.keys (bower_dependencies bowerInfo)
             pure $
               ( pkgName
               , PackageInfo
                 (T.replace "git:" "https:" . url $ bower_repository bowerInfo)
-                ("v" <> bower_version bowerInfo)
+                version'
                 packageNames
               )
       case result' of
@@ -536,6 +540,10 @@ addFromBower name = do
   where
     stripBowerNamePrefix s = fromMaybe s $ T.stripPrefix "purescript-" s
     mkPackageName' = Bifunctor.first show . mkPackageName . stripBowerNamePrefix
+    parseVersion' s = case s of
+      "" -> Nothing
+      s' -> Just $ T.tail s'
+    (name, version) = Bifunctor.second parseVersion' $ T.breakOn "#" $ T.pack arg
 
 formatPackageFile :: IO ()
 formatPackageFile =

psc-package.cabal

@@ -25,6 +25,7 @@ executable psc-package
                    process -any,
                    system-filepath -any,
                    text -any,
+                   errors -any,
                    turtle <1.6
     main-is: Main.hs
     other-modules: Paths_psc_package