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