nmattia/niv
1
1
Fork 0
mirror of https://github.com/nmattia/niv.git synced 2024-09-16 18:07:20 +03:00
Code Issues Projects Releases Wiki Activity

Use fewer String s

Browse Source
This commit is contained in:
Nicolas Mattia 2019-05-13 15:43:57 +02:00
parent d758b48ea0
commit 8464154e38
1 changed files with 49 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
app/Niv.hs
View File

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