mirror of
https://github.com/nmattia/niv.git
synced 2024-09-07 13:05:39 +03:00
Use fewer String s
This commit is contained in:
Nicolas Mattia
parent
d758b48ea0
commit
8464154e38
93
app/Niv.hs
93
app/Niv.hs
@ -11,7 +11,7 @@ import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.State
|
||||
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
|
||||
import Data.Char (isSpace, toUpper)
|
||||
import Data.Char (isSpace)
|
||||
import Data.FileEmbed (embedFile)
|
||||
import Data.Functor ((<&>))
|
||||
import Data.Hashable (Hashable)
|
||||
@ -29,6 +29,7 @@ import qualified Data.ByteString.Char8 as B8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified GitHub as GH
|
||||
import qualified GitHub.Data.Name as GH
|
||||
import qualified Options.Applicative as Opts
|
||||
@ -70,7 +71,7 @@ getSources = do
|
||||
forM (HMap.toList obj) $ \(k, v) ->
|
||||
case v of
|
||||
Aeson.Object v' ->
|
||||
pure $ HMap.singleton (PackageName (T.unpack k)) (PackageSpec v')
|
||||
pure $ HMap.singleton (PackageName k) (PackageSpec v')
|
||||
_ -> abortAttributeIsntAMap
|
||||
Just _ -> abortSourcesIsntAMap
|
||||
Nothing -> abortSourcesIsntJSON
|
||||
@ -78,7 +79,7 @@ getSources = do
|
||||
setSources :: Sources -> IO ()
|
||||
setSources sources = encodeFile pathNixSourcesJson sources
|
||||
|
||||
newtype PackageName = PackageName { unPackageName :: String }
|
||||
newtype PackageName = PackageName { unPackageName :: T.Text }
|
||||
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
|
||||
|
||||
parsePackageName :: Opts.Parser PackageName
|
||||
@ -93,7 +94,7 @@ parsePackageSpec =
|
||||
(PackageSpec . HMap.fromList . fmap fixupAttributes) <$>
|
||||
many parseAttribute
|
||||
where
|
||||
parseAttribute :: Opts.Parser (String, String)
|
||||
parseAttribute :: Opts.Parser (T.Text, T.Text)
|
||||
parseAttribute =
|
||||
Opts.option (Opts.maybeReader parseKeyVal)
|
||||
( Opts.long "attribute" <>
|
||||
@ -115,32 +116,32 @@ parsePackageSpec =
|
||||
))
|
||||
|
||||
-- Parse "key=val" into ("key", "val")
|
||||
parseKeyVal :: String -> Maybe (String, String)
|
||||
parseKeyVal :: String -> Maybe (T.Text, T.Text)
|
||||
parseKeyVal str = case span (/= '=') str of
|
||||
(key, '=':val) -> Just (key, val)
|
||||
(key, '=':val) -> Just (T.pack key, T.pack val)
|
||||
_ -> Nothing
|
||||
|
||||
-- Shortcuts for common attributes
|
||||
shortcutAttributes :: Opts.Parser (String, String)
|
||||
shortcutAttributes :: Opts.Parser (T.Text, T.Text)
|
||||
shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$>
|
||||
[ "branch", "owner", "repo", "version" ]
|
||||
|
||||
mkShortcutAttribute :: String -> Opts.Parser (String, String)
|
||||
mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, T.Text)
|
||||
mkShortcutAttribute = \case
|
||||
attr@(c:_) -> (attr,) <$> Opts.strOption
|
||||
( Opts.long attr <>
|
||||
attr@(T.uncons -> Just (c,_)) -> (attr,) <$> Opts.strOption
|
||||
( Opts.long (T.unpack attr) <>
|
||||
Opts.short c <>
|
||||
Opts.metavar (toUpper <$> attr) <>
|
||||
Opts.metavar (T.unpack $ T.toUpper attr) <>
|
||||
Opts.help
|
||||
(
|
||||
( T.unpack $
|
||||
"Equivalent to --attribute " <>
|
||||
attr <> "=<" <> (toUpper <$> attr) <> ">"
|
||||
attr <> "=<" <> (T.toUpper attr) <> ">"
|
||||
)
|
||||
)
|
||||
_ -> empty
|
||||
|
||||
fixupAttributes :: (String, String) -> (T.Text, Aeson.Value)
|
||||
fixupAttributes (k, v) = (T.pack k, Aeson.String (T.pack v))
|
||||
fixupAttributes :: (T.Text, T.Text) -> (T.Text, Aeson.Value)
|
||||
fixupAttributes (k, v) = (k, Aeson.String v)
|
||||
|
||||
parsePackage :: Opts.Parser (PackageName, PackageSpec)
|
||||
parsePackage = (,) <$> parsePackageName <*> parsePackageSpec
|
||||
@ -250,10 +251,10 @@ completePackageSpec = execStateT $ do
|
||||
whenNotSet "url_template" $
|
||||
setPackageSpecAttr
|
||||
"url_template"
|
||||
(Aeson.String $ T.pack githubURLTemplate)
|
||||
(Aeson.String githubURLTemplate)
|
||||
|
||||
where
|
||||
githubURLTemplate :: String
|
||||
githubURLTemplate :: T.Text
|
||||
githubURLTemplate =
|
||||
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||
|
||||
@ -384,12 +385,13 @@ cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO ()
|
||||
cmdAdd mPackageName (PackageName str, spec) = do
|
||||
|
||||
-- Figures out the owner and repo
|
||||
(packageName, spec') <- flip runStateT spec $ case span (/= '/') str of
|
||||
(owner@(_:_), '/':repo@(_:_)) -> do
|
||||
(packageName, spec') <- flip runStateT spec $ case T.span (/= '/') str of
|
||||
( owner@(T.null -> False)
|
||||
, T.uncons -> Just ('/', repo@(T.null -> False))) -> do
|
||||
whenNotSet "owner" $
|
||||
setPackageSpecAttr "owner" (Aeson.String $ T.pack owner)
|
||||
setPackageSpecAttr "owner" (Aeson.String owner)
|
||||
whenNotSet "repo" $ do
|
||||
setPackageSpecAttr "repo" (Aeson.String $ T.pack repo)
|
||||
setPackageSpecAttr "repo" (Aeson.String repo)
|
||||
pure (PackageName repo)
|
||||
_ -> pure (PackageName str)
|
||||
|
||||
@ -420,7 +422,7 @@ cmdShow = do
|
||||
sources <- unSources <$> getSources
|
||||
|
||||
forWithKeyM_ sources $ \key (PackageSpec spec) -> do
|
||||
putStrLn $ "Package: " <> unPackageName key
|
||||
T.putStrLn $ "Package: " <> unPackageName key
|
||||
forM_ (HMap.toList spec) $ \(attrName, attrValValue) -> do
|
||||
let attrValue = case attrValValue of
|
||||
Aeson.String str -> str
|
||||
@ -451,7 +453,7 @@ parseCmdUpdate =
|
||||
cmdUpdate :: Maybe (PackageName, PackageSpec) -> IO ()
|
||||
cmdUpdate = \case
|
||||
Just (packageName, packageSpec) -> do
|
||||
putStrLn $ "Updating single package: " <> unPackageName packageName
|
||||
T.putStrLn $ "Updating single package: " <> unPackageName packageName
|
||||
sources <- unSources <$> getSources
|
||||
|
||||
packageSpec' <- case HMap.lookup packageName sources of
|
||||
@ -471,7 +473,7 @@ cmdUpdate = \case
|
||||
|
||||
sources' <- forWithKeyM sources $
|
||||
\packageName packageSpec -> do
|
||||
putStrLn $ "Package: " <> unPackageName packageName
|
||||
T.putStrLn $ "Package: " <> unPackageName packageName
|
||||
updatePackageSpec =<< completePackageSpec packageSpec
|
||||
|
||||
setSources $ Sources sources'
|
||||
@ -503,7 +505,7 @@ parseCmdDrop =
|
||||
cmdDrop :: PackageName -> [T.Text] -> IO ()
|
||||
cmdDrop packageName = \case
|
||||
[] -> do
|
||||
putStrLn $ "Dropping package: " <> unPackageName packageName
|
||||
T.putStrLn $ "Dropping package: " <> unPackageName packageName
|
||||
sources <- unSources <$> getSources
|
||||
|
||||
when (not $ HMap.member packageName sources) $
|
||||
@ -514,7 +516,7 @@ cmdDrop packageName = \case
|
||||
attrs -> do
|
||||
putStrLn $ "Dropping attributes :" <>
|
||||
(T.unpack (T.intercalate " " attrs))
|
||||
putStrLn $ "In package: " <> unPackageName packageName
|
||||
T.putStrLn $ "In package: " <> unPackageName packageName
|
||||
sources <- unSources <$> getSources
|
||||
|
||||
packageSpec <- case HMap.lookup packageName sources of
|
||||
@ -600,9 +602,9 @@ renderTemplate vals = \case
|
||||
c:str -> (c:) <$> renderTemplate vals str
|
||||
[] -> Just []
|
||||
|
||||
abort :: String -> IO a
|
||||
abort :: T.Text -> IO a
|
||||
abort msg = do
|
||||
putStrLn msg
|
||||
T.putStrLn msg
|
||||
exitFailure
|
||||
|
||||
nixPrefetchURL :: Bool -> String -> IO String
|
||||
@ -637,18 +639,18 @@ shouldUpdateNixSourcesNix content =
|
||||
warnIfOutdated :: IO ()
|
||||
warnIfOutdated = do
|
||||
tryAny (B.readFile pathNixSourcesNix) >>= \case
|
||||
Left e -> putStrLn $ unlines
|
||||
[ "Could not read " <> pathNixSourcesNix
|
||||
, "Error: " <> show e
|
||||
Left e -> T.putStrLn $ T.unlines
|
||||
[ "Could not read " <> T.pack pathNixSourcesNix
|
||||
, "Error: " <> tshow e
|
||||
]
|
||||
Right content ->
|
||||
if shouldUpdateNixSourcesNix content
|
||||
then
|
||||
putStrLn $ unlines
|
||||
[ "WARNING: " <> pathNixSourcesNix <> " is out of date."
|
||||
T.putStrLn $ T.unlines
|
||||
[ "WARNING: " <> T.pack pathNixSourcesNix <> " is out of date."
|
||||
, "Please run"
|
||||
, " niv init"
|
||||
, "or add the following line in the " <> pathNixSourcesNix <> " file:"
|
||||
, "or add the following line in the " <> T.pack pathNixSourcesNix <> " file:"
|
||||
, " # niv: no_update"
|
||||
]
|
||||
else pure ()
|
||||
@ -707,9 +709,9 @@ The sources file does not exist! You may need to run 'niv init'.
|
||||
|]
|
||||
|
||||
abortSourcesIsntAMap :: IO a
|
||||
abortSourcesIsntAMap = abort $ unlines [ line1, line2 ]
|
||||
abortSourcesIsntAMap = abort $ T.unlines [ line1, line2 ]
|
||||
where
|
||||
line1 = "Cannot use " <> pathNixSourcesJson
|
||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||
line2 = [s|
|
||||
The sources file should be a JSON map from package name to package
|
||||
specification, e.g.:
|
||||
@ -717,9 +719,9 @@ specification, e.g.:
|
||||
|]
|
||||
|
||||
abortAttributeIsntAMap :: IO a
|
||||
abortAttributeIsntAMap = abort $ unlines [ line1, line2 ]
|
||||
abortAttributeIsntAMap = abort $ T.unlines [ line1, line2 ]
|
||||
where
|
||||
line1 = "Cannot use " <> pathNixSourcesJson
|
||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||
line2 = [s|
|
||||
The package specifications in the sources file should be JSON maps from
|
||||
attribute name to attribute value, e.g.:
|
||||
@ -727,13 +729,13 @@ attribute name to attribute value, e.g.:
|
||||
|]
|
||||
|
||||
abortSourcesIsntJSON :: IO a
|
||||
abortSourcesIsntJSON = abort $ unlines [ line1, line2 ]
|
||||
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ]
|
||||
where
|
||||
line1 = "Cannot use " <> pathNixSourcesJson
|
||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||
line2 = "The sources file should be JSON."
|
||||
|
||||
abortCannotAddPackageExists :: PackageName -> IO a
|
||||
abortCannotAddPackageExists (PackageName n) = abort $ unlines
|
||||
abortCannotAddPackageExists (PackageName n) = abort $ T.unlines
|
||||
[ "Cannot add package " <> n <> "."
|
||||
, "The package already exists. Use"
|
||||
, " niv drop " <> n
|
||||
@ -743,7 +745,7 @@ abortCannotAddPackageExists (PackageName n) = abort $ unlines
|
||||
]
|
||||
|
||||
abortCannotUpdateNoSuchPackage :: PackageName -> IO a
|
||||
abortCannotUpdateNoSuchPackage (PackageName n) = abort $ unlines
|
||||
abortCannotUpdateNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||
[ "Cannot update package " <> n <> "."
|
||||
, "The package doesn't exist. Use"
|
||||
, " niv add " <> n
|
||||
@ -751,13 +753,13 @@ abortCannotUpdateNoSuchPackage (PackageName n) = abort $ unlines
|
||||
]
|
||||
|
||||
abortCannotDropNoSuchPackage :: PackageName -> IO a
|
||||
abortCannotDropNoSuchPackage (PackageName n) = abort $ unlines
|
||||
abortCannotDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||
[ "Cannot drop package " <> n <> "."
|
||||
, "The package doesn't exist."
|
||||
]
|
||||
|
||||
abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a
|
||||
abortCannotAttributesDropNoSuchPackage (PackageName n) = abort $ unlines
|
||||
abortCannotAttributesDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||
[ "Cannot drop attributes of package " <> n <> "."
|
||||
, "The package doesn't exist."
|
||||
]
|
||||
@ -771,3 +773,6 @@ ticket:
|
||||
|
||||
Thanks! I'll buy you a beer.
|
||||
|]
|
||||
|
||||
tshow :: Show a => a -> T.Text
|
||||
tshow = T.pack . show
|
||||
|
||||
Loading…
Reference in New Issue
Block a user