mirror of
https://github.com/nmattia/niv.git
synced 2024-09-16 01:47:08 +03:00
Prettify logs more
This commit is contained in:
parent
44c52165a8
commit
09d62db86b
@ -169,7 +169,7 @@ rec
|
|||||||
|
|
||||||
pushd $(mktemp -d)
|
pushd $(mktemp -d)
|
||||||
${pkgs.termtosvg}/bin/termtosvg \
|
${pkgs.termtosvg}/bin/termtosvg \
|
||||||
-g 82x26 -M 500 -m 500 -t window_frame \
|
-g 82x26 -M 500 -m 500 -t window_frame_js \
|
||||||
-c '${niv-svg-cmds}' $site/niv.svg
|
-c '${niv-svg-cmds}' $site/niv.svg
|
||||||
|
|
||||||
echo done rendering
|
echo done rendering
|
||||||
|
@ -32,6 +32,7 @@ dependencies:
|
|||||||
- mtl
|
- mtl
|
||||||
- optparse-applicative
|
- optparse-applicative
|
||||||
- process
|
- process
|
||||||
|
- profunctors
|
||||||
- string-qq
|
- string-qq
|
||||||
- text
|
- text
|
||||||
- unliftio
|
- unliftio
|
||||||
|
@ -3,6 +3,7 @@
|
|||||||
#!nix-shell -I nixpkgs=./nix
|
#!nix-shell -I nixpkgs=./nix
|
||||||
#!nix-shell -p nix
|
#!nix-shell -p nix
|
||||||
#!nix-shell --keep SSL_CERT_FILE
|
#!nix-shell --keep SSL_CERT_FILE
|
||||||
|
#!nix-shell --keep GITHUB_TOKEN
|
||||||
#!nix-shell --pure
|
#!nix-shell --pure
|
||||||
|
|
||||||
set -euo pipefail
|
set -euo pipefail
|
||||||
|
255
site/niv.svg
255
site/niv.svg
File diff suppressed because one or more lines are too long
Before Width: | Height: | Size: 15 KiB After Width: | Height: | Size: 13 KiB |
@ -65,7 +65,7 @@ getSources = do
|
|||||||
|
|
||||||
warnIfOutdated
|
warnIfOutdated
|
||||||
-- TODO: if doesn't exist: run niv init
|
-- TODO: if doesn't exist: run niv init
|
||||||
putStrLn $ "Reading sources file"
|
say $ "Reading sources file"
|
||||||
decodeFileStrict pathNixSourcesJson >>= \case
|
decodeFileStrict pathNixSourcesJson >>= \case
|
||||||
Just (Aeson.Object obj) ->
|
Just (Aeson.Object obj) ->
|
||||||
fmap (Sources . mconcat) $
|
fmap (Sources . mconcat) $
|
||||||
@ -167,7 +167,7 @@ parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
|
|||||||
|
|
||||||
cmdInit :: IO ()
|
cmdInit :: IO ()
|
||||||
cmdInit = do
|
cmdInit = do
|
||||||
job "initializing" $ do
|
job "Initializing" $ do
|
||||||
|
|
||||||
-- Writes all the default files
|
-- Writes all the default files
|
||||||
-- a path, a "create" function and an update function for each file.
|
-- a path, a "create" function and an update function for each file.
|
||||||
@ -177,17 +177,17 @@ cmdInit = do
|
|||||||
, \path content -> do
|
, \path content -> do
|
||||||
if shouldUpdateNixSourcesNix content
|
if shouldUpdateNixSourcesNix content
|
||||||
then do
|
then do
|
||||||
putStrLn "Updating sources.nix"
|
say "Updating sources.nix"
|
||||||
B.writeFile path initNixSourcesNixContent
|
B.writeFile path initNixSourcesNixContent
|
||||||
else putStrLn "Not updating sources.nix"
|
else say "Not updating sources.nix"
|
||||||
)
|
)
|
||||||
, ( pathNixSourcesJson
|
, ( pathNixSourcesJson
|
||||||
, \path -> do
|
, \path -> do
|
||||||
createFile path initNixSourcesJsonContent
|
createFile path initNixSourcesJsonContent
|
||||||
-- Imports @niv@ and @nixpkgs@ (19.03)
|
-- Imports @niv@ and @nixpkgs@ (19.03)
|
||||||
putStrLn "Importing 'niv' ..."
|
say "Importing 'niv' ..."
|
||||||
cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty)
|
cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty)
|
||||||
putStrLn "Importing 'nixpkgs' ..."
|
say "Importing 'nixpkgs' ..."
|
||||||
cmdAdd
|
cmdAdd
|
||||||
(Just (PackageName "nixpkgs"))
|
(Just (PackageName "nixpkgs"))
|
||||||
( PackageName "NixOS/nixpkgs-channels"
|
( PackageName "NixOS/nixpkgs-channels"
|
||||||
@ -201,10 +201,10 @@ cmdInit = do
|
|||||||
createFile path content = do
|
createFile path content = do
|
||||||
let dir = takeDirectory path
|
let dir = takeDirectory path
|
||||||
Dir.createDirectoryIfMissing True dir
|
Dir.createDirectoryIfMissing True dir
|
||||||
putStrLn $ "Creating " <> path
|
say $ "Creating " <> path
|
||||||
B.writeFile path content
|
B.writeFile path content
|
||||||
dontCreateFile :: FilePath -> IO ()
|
dontCreateFile :: FilePath -> IO ()
|
||||||
dontCreateFile path = putStrLn $ "Not creating " <> path
|
dontCreateFile path = say $ "Not creating " <> path
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- ADD
|
-- ADD
|
||||||
@ -234,36 +234,37 @@ parseCmdAdd =
|
|||||||
]
|
]
|
||||||
|
|
||||||
cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO ()
|
cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO ()
|
||||||
cmdAdd mPackageName (PackageName str, cliSpec) = do
|
cmdAdd mPackageName (PackageName str, cliSpec) =
|
||||||
|
job ("Adding package " <> T.unpack str) $ do
|
||||||
|
|
||||||
-- Figures out the owner and repo
|
-- Figures out the owner and repo
|
||||||
let (packageName, defaultSpec) = case T.span (/= '/') str of
|
let (packageName, defaultSpec) = case T.span (/= '/') str of
|
||||||
( owner@(T.null -> False)
|
( owner@(T.null -> False)
|
||||||
, T.uncons -> Just ('/', repo@(T.null -> False))) -> do
|
, T.uncons -> Just ('/', repo@(T.null -> False))) -> do
|
||||||
(PackageName repo, HMS.fromList [ "owner" .= owner, "repo" .= repo ])
|
(PackageName repo, HMS.fromList [ "owner" .= owner, "repo" .= repo ])
|
||||||
_ -> (PackageName str, HMS.empty)
|
_ -> (PackageName str, HMS.empty)
|
||||||
|
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
let packageName' = fromMaybe packageName mPackageName
|
let packageName' = fromMaybe packageName mPackageName
|
||||||
|
|
||||||
when (HMS.member packageName' sources) $
|
when (HMS.member packageName' sources) $
|
||||||
abortCannotAddPackageExists packageName'
|
abortCannotAddPackageExists packageName'
|
||||||
|
|
||||||
let defaultSpec' = PackageSpec $ defaultSpec
|
let defaultSpec' = PackageSpec $ defaultSpec
|
||||||
|
|
||||||
let initialSpec = specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec'
|
let initialSpec = specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec'
|
||||||
|
|
||||||
eFinalSpec <- fmap attrsToSpec <$> tryEvalUpdate
|
eFinalSpec <- fmap attrsToSpec <$> tryEvalUpdate
|
||||||
initialSpec
|
initialSpec
|
||||||
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
||||||
|
|
||||||
case eFinalSpec of
|
case eFinalSpec of
|
||||||
Left e -> abortUpdateFailed [(packageName', e)]
|
Left e -> abortUpdateFailed [(packageName', e)]
|
||||||
Right finalSpec -> do
|
Right finalSpec -> do
|
||||||
putStrLn $ "Writing new sources file"
|
say $ "Writing new sources file"
|
||||||
setSources $ Sources $
|
setSources $ Sources $
|
||||||
HMS.insert packageName' finalSpec sources
|
HMS.insert packageName' finalSpec sources
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- SHOW
|
-- SHOW
|
||||||
@ -279,7 +280,7 @@ parseCmdShow =
|
|||||||
cmdShow :: Maybe PackageName -> IO ()
|
cmdShow :: Maybe PackageName -> IO ()
|
||||||
cmdShow = \case
|
cmdShow = \case
|
||||||
Just packageName -> do
|
Just packageName -> do
|
||||||
putStrLn $ "Showing package " <> T.unpack (unPackageName packageName)
|
tsay $ "Showing package " <> unPackageName packageName
|
||||||
|
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
@ -289,21 +290,21 @@ cmdShow = \case
|
|||||||
let attrValue = case attrValValue of
|
let attrValue = case attrValValue of
|
||||||
Aeson.String str -> str
|
Aeson.String str -> str
|
||||||
_ -> "<barabajagal>"
|
_ -> "<barabajagal>"
|
||||||
putStrLn $ " " <> T.unpack attrName <> ": " <> T.unpack attrValue
|
tsay $ " " <> attrName <> ": " <> attrValue
|
||||||
Nothing -> abortCannotShowNoSuchPackage packageName
|
Nothing -> abortCannotShowNoSuchPackage packageName
|
||||||
|
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
putStrLn $ "Showing sources file"
|
say $ "Showing sources file"
|
||||||
|
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
forWithKeyM_ sources $ \key (PackageSpec spec) -> do
|
forWithKeyM_ sources $ \key (PackageSpec spec) -> do
|
||||||
T.putStrLn $ "Package: " <> unPackageName key
|
tsay $ "Updating " <> tbold (unPackageName key)
|
||||||
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
|
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
|
||||||
let attrValue = case attrValValue of
|
let attrValue = case attrValValue of
|
||||||
Aeson.String str -> str
|
Aeson.String str -> str
|
||||||
_ -> "<barabajagal>"
|
_ -> tfaint "<barabajagal>"
|
||||||
putStrLn $ " " <> T.unpack attrName <> ": " <> T.unpack attrValue
|
tsay $ " " <> attrName <> ": " <> attrValue
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- UPDATE
|
-- UPDATE
|
||||||
@ -358,7 +359,7 @@ cmdUpdate = \case
|
|||||||
|
|
||||||
esources' <- forWithKeyM sources $
|
esources' <- forWithKeyM sources $
|
||||||
\packageName defaultSpec -> do
|
\packageName defaultSpec -> do
|
||||||
T.putStrLn $ "Package: " <> unPackageName packageName
|
tsay $ "Package: " <> unPackageName packageName
|
||||||
let initialSpec = specToFreeAttrs defaultSpec
|
let initialSpec = specToFreeAttrs defaultSpec
|
||||||
finalSpec <- fmap attrsToSpec <$> tryEvalUpdate
|
finalSpec <- fmap attrsToSpec <$> tryEvalUpdate
|
||||||
initialSpec
|
initialSpec
|
||||||
@ -402,7 +403,7 @@ parseCmdModify =
|
|||||||
|
|
||||||
cmdModify :: (PackageName, PackageSpec) -> IO ()
|
cmdModify :: (PackageName, PackageSpec) -> IO ()
|
||||||
cmdModify (packageName, cliSpec) = do
|
cmdModify (packageName, cliSpec) = do
|
||||||
T.putStrLn $ "Modifying package: " <> unPackageName packageName
|
tsay $ "Modifying package: " <> unPackageName packageName
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
finalSpec <- case HMS.lookup packageName sources of
|
finalSpec <- case HMS.lookup packageName sources of
|
||||||
@ -438,7 +439,7 @@ parseCmdDrop =
|
|||||||
cmdDrop :: PackageName -> [T.Text] -> IO ()
|
cmdDrop :: PackageName -> [T.Text] -> IO ()
|
||||||
cmdDrop packageName = \case
|
cmdDrop packageName = \case
|
||||||
[] -> do
|
[] -> do
|
||||||
T.putStrLn $ "Dropping package: " <> unPackageName packageName
|
tsay $ "Dropping package: " <> unPackageName packageName
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
when (not $ HMS.member packageName sources) $
|
when (not $ HMS.member packageName sources) $
|
||||||
@ -447,9 +448,8 @@ cmdDrop packageName = \case
|
|||||||
setSources $ Sources $
|
setSources $ Sources $
|
||||||
HMS.delete packageName sources
|
HMS.delete packageName sources
|
||||||
attrs -> do
|
attrs -> do
|
||||||
putStrLn $ "Dropping attributes :" <>
|
tsay $ "Dropping attributes :" <> T.intercalate " " attrs
|
||||||
(T.unpack (T.intercalate " " attrs))
|
tsay $ "In package: " <> unPackageName packageName
|
||||||
T.putStrLn $ "In package: " <> unPackageName packageName
|
|
||||||
sources <- unSources <$> getSources
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
packageSpec <- case HMS.lookup packageName sources of
|
packageSpec <- case HMS.lookup packageName sources of
|
||||||
|
@ -5,36 +5,66 @@
|
|||||||
|
|
||||||
module Niv.Logger where
|
module Niv.Logger where
|
||||||
|
|
||||||
import qualified System.Console.ANSI as ANSI
|
import Control.Monad
|
||||||
import Data.String (IsString)
|
import Data.Profunctor
|
||||||
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
import qualified Data.Text as T
|
||||||
import UnliftIO
|
import UnliftIO
|
||||||
|
import qualified System.Console.ANSI as ANSI
|
||||||
|
|
||||||
|
-- XXX: this assumes as single thread
|
||||||
job :: String -> IO () -> IO ()
|
job :: String -> IO () -> IO ()
|
||||||
job str act = do
|
job str act = do
|
||||||
say (bold str)
|
say (bold str)
|
||||||
tryAny act >>= \case
|
indent
|
||||||
Right () -> say $ green "Done" <> ": " <> Log str
|
tryAny act <* deindent >>= \case
|
||||||
Left e -> say $ red "ERROR" <> ":\n" <> Log (show e)
|
Right () -> say $ green "Done" <> ": " <> str
|
||||||
|
Left e -> say $ red "ERROR" <> ":\n" <> show e
|
||||||
|
where
|
||||||
|
indent = void $ atomicModifyIORef jobStack (\x -> (x + 1, undefined))
|
||||||
|
deindent = void $ atomicModifyIORef jobStack (\x -> (x - 1, undefined))
|
||||||
|
|
||||||
newtype Log = Log { unLog :: String }
|
jobStackSize :: IO Int
|
||||||
deriving newtype (Semigroup, Monoid, IsString)
|
jobStackSize = readIORef jobStack
|
||||||
|
|
||||||
say :: Log -> IO ()
|
jobStack :: IORef Int
|
||||||
say = putStrLn . unLog
|
jobStack = unsafePerformIO $ newIORef 0
|
||||||
|
{-# NOINLINE jobStackSize #-}
|
||||||
|
|
||||||
green :: String -> Log
|
tsay :: T.Text -> IO ()
|
||||||
green str = Log $
|
tsay = say . T.unpack
|
||||||
|
|
||||||
|
say :: String -> IO ()
|
||||||
|
say msg = do
|
||||||
|
stackSize <- jobStackSize
|
||||||
|
let indent = replicate (stackSize * 2) ' '
|
||||||
|
putStrLn $ indent <> msg
|
||||||
|
|
||||||
|
green :: String -> String
|
||||||
|
green str =
|
||||||
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
|
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
|
||||||
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green] <>
|
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green] <>
|
||||||
str <> ANSI.setSGRCode [ANSI.Reset]
|
str <> ANSI.setSGRCode [ANSI.Reset]
|
||||||
|
|
||||||
red :: String -> Log
|
red :: String -> String
|
||||||
red str = Log $
|
red str =
|
||||||
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] <>
|
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] <>
|
||||||
str <> ANSI.setSGRCode [ANSI.Reset]
|
str <> ANSI.setSGRCode [ANSI.Reset]
|
||||||
|
|
||||||
bold :: String -> Log
|
tbold :: T.Text -> T.Text
|
||||||
bold str = Log $
|
tbold = dimap T.unpack T.pack bold
|
||||||
|
|
||||||
|
bold :: String -> String
|
||||||
|
bold str =
|
||||||
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
|
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
|
||||||
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>
|
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>
|
||||||
str <> ANSI.setSGRCode [ANSI.Reset]
|
str <> ANSI.setSGRCode [ANSI.Reset]
|
||||||
|
|
||||||
|
tfaint :: T.Text -> T.Text
|
||||||
|
tfaint = dimap T.unpack T.pack faint
|
||||||
|
|
||||||
|
faint :: String -> String
|
||||||
|
faint str =
|
||||||
|
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.FaintIntensity] <>
|
||||||
|
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>
|
||||||
|
str <> ANSI.setSGRCode [ANSI.Reset]
|
||||||
|
Loading…
Reference in New Issue
Block a user