Switch to relude
This commit is contained in:
parent
522deabe83
commit
74c287a996
|
@ -44,7 +44,7 @@ let
|
|||
batteryLevel <- maybe (fail "Couldn‘t get battery level") pure $ parseMaybe levelParser batteryLevelText
|
||||
pure $ BatState chargerOnline batteryLevel
|
||||
|
||||
type Parser = Parsec Text LT.Text
|
||||
type Parser = Parsec Text LText
|
||||
|
||||
onlineParser :: Parser Bool
|
||||
onlineParser = not . null . rights <$> sepCap (string "on-line")
|
||||
|
|
|
@ -3,15 +3,14 @@ let
|
|||
inherit (import ../../lib) writeHaskellScript;
|
||||
randomWallpaper = writeHaskellScript {
|
||||
name = "random-wallpaper";
|
||||
imports = [ "System.Random" "Control.Concurrent" ];
|
||||
imports = [ "System.Random" ];
|
||||
bins = [ pkgs.coreutils pkgs.sway ];
|
||||
} ''
|
||||
main = forever $ do
|
||||
files <- fmap (lines . decodeUtf8) $ ls "/home/maralorn/.wallpapers" |> captureTrim
|
||||
file <- fmap (files Prelude.!!) $ getStdRandom $ randomR (0, length files - 1)
|
||||
file <- fmap (files Unsafe.!!) $ getStdRandom $ randomR (0, length files - 1)
|
||||
cp ([i|/home/maralorn/.wallpapers/#{file}|] :: String) "/home/maralorn/volatile/wallpaper.jpg"
|
||||
swaymsg "output * bg /home/maralorn/volatile/wallpaper.jpg fill"
|
||||
threadDelay 300000000
|
||||
'';
|
||||
in {
|
||||
|
||||
|
@ -20,10 +19,12 @@ in {
|
|||
Unit = { Description = "Random Wallpaper"; };
|
||||
Service = {
|
||||
ExecStart = "${randomWallpaper}/bin/random-wallpaper";
|
||||
Restart = "always";
|
||||
RestartSec = "10";
|
||||
Type = "oneshot";
|
||||
};
|
||||
Install = { WantedBy = [ "graphical-session.target" ]; };
|
||||
};
|
||||
timers.random-wallpaper = {
|
||||
Timer = { OnCalendar = "*:*:0/5"; };
|
||||
Install = { WantedBy = [ "timers.target" ]; };
|
||||
};
|
||||
};
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
home.file = let
|
||||
functions = ''
|
||||
printMap :: HashMap Text (These Value Value) -> String
|
||||
printMap = intercalate "\n" . fmap printPair . ClassyPrelude.filter filterPairs . HM.toList
|
||||
printMap = intercalate "\n" . fmap printPair . filter filterPairs . HM.toList
|
||||
filterPairs = \(k,_) -> k `notElem` ["uuid","entry","modified"]
|
||||
printPair = \(k,v) -> case v of
|
||||
This old -> [i|#{k}: -#{printValue old}|]
|
||||
|
@ -20,11 +20,11 @@
|
|||
[i|#{k}: #{intercalate ", " ((('-':) . printValue <$> old) ++ (('+':) . printValue <$> new))}|]
|
||||
printDiff k old new = [i|#{k}: +#{printValue new} -#{printValue old}|]
|
||||
printValue = \case
|
||||
String (unpack -> a) -> if | Just (d :: UTCTime) <- parseTimeM False defaultTimeLocale "%Y%m%dT%H%M%SZ" a -> show d
|
||||
| otherwise -> a
|
||||
String (toString -> a) -> if | Just (d :: UTCTime) <- parseTimeM False defaultTimeLocale "%Y%m%dT%H%M%SZ" a -> show d
|
||||
| otherwise -> a
|
||||
Number a -> show a
|
||||
Array (fmap printValue -> a) -> intercalate "\n" a
|
||||
Object a -> show $ HM.toList a
|
||||
Array (fmap printValue -> a) -> intercalate "\n" (toList a)
|
||||
Object a -> show $ toList a
|
||||
Bool a -> show a
|
||||
Null -> "null"
|
||||
'';
|
||||
|
@ -40,7 +40,7 @@
|
|||
"Data.Aeson"
|
||||
"Control.Monad"
|
||||
"Data.These"
|
||||
"Data.HashMap.Strict as HM"
|
||||
"qualified Data.HashMap.Strict as HM"
|
||||
"Data.Time"
|
||||
"qualified Data.Vector as V"
|
||||
"qualified Data.List as List"
|
||||
|
@ -54,8 +54,8 @@
|
|||
input1 <- BS.hGetLine stdin
|
||||
input2 <- BS.hGetLine stdin
|
||||
let description = do
|
||||
Object task1 <- decode $ LBSC.fromStrict input1 :: Maybe Value
|
||||
Object task2 <- decode $ LBSC.fromStrict input2 :: Maybe Value
|
||||
Object task1 <- decode $ toLazy input1 :: Maybe Value
|
||||
Object task2 <- decode $ toLazy input2 :: Maybe Value
|
||||
let diff = HM.unions [
|
||||
fmap This (HM.difference task1 task2),
|
||||
fmap That (HM.difference task2 task1),
|
||||
|
@ -66,7 +66,7 @@
|
|||
Control.Monad.forM_ description $ \(d,b) -> do
|
||||
client <- connectSession
|
||||
notify client blankNote { summary = [i|Modified task #{d}|], body = Just $ Text b, expiry = Milliseconds 15000 }
|
||||
hPut stdout input2
|
||||
BS.hPut stdout input2
|
||||
'';
|
||||
on-add = writeHaskellScript {
|
||||
inherit imports libraries;
|
||||
|
@ -74,14 +74,14 @@
|
|||
} ''
|
||||
${functions}
|
||||
main = do
|
||||
input <- LBSC.hGetContents stdin
|
||||
input <- BS.hGetContents stdin
|
||||
let description = do
|
||||
Object task <- decode input :: Maybe Value
|
||||
Object task <- decode $ toLazy input :: Maybe Value
|
||||
pure . printMap . fmap That $ task
|
||||
Control.Monad.forM_ description $ \d -> do
|
||||
client <- connectSession
|
||||
notify client blankNote { summary = "New Task", body = Just $ Text d, expiry = Milliseconds 15000 }
|
||||
LBS.hPut stdout input
|
||||
BS.hPut stdout input
|
||||
'';
|
||||
in {
|
||||
"add-notification" = {
|
||||
|
|
|
@ -47,7 +47,7 @@ rec {
|
|||
libraries = libraries ++ [
|
||||
shh
|
||||
pkgs.haskellPackages.string-interpolate
|
||||
pkgs.haskellPackages.classy-prelude
|
||||
pkgs.haskellPackages.relude
|
||||
];
|
||||
} ''
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
@ -59,19 +59,16 @@ rec {
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
import Shh
|
||||
import qualified Prelude
|
||||
import ClassyPrelude
|
||||
import Data.String.Interpolate (i)
|
||||
import Relude
|
||||
import qualified Relude.Unsafe as Unsafe
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBSC
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.Text.Lazy.Encoding as LTE
|
||||
import qualified Data.Text as Text
|
||||
import System.Environment (getArgs)
|
||||
import Control.Exception (bracket)
|
||||
import Data.String.Interpolate (i)
|
||||
${builtins.concatStringsSep "\n" (map (x: "import ${x}") imports)}
|
||||
|
||||
-- Load binaries from Nix packages. The dependencies will be captured
|
||||
|
@ -89,7 +86,7 @@ rec {
|
|||
libraries = [ pkgs.haskellPackages.cmdargs pkgs.haskellPackages.text ];
|
||||
} ''
|
||||
|
||||
trimQuotation = pureProc $ LTE.encodeUtf8 . LT.dropAround ('"' ==) . LTE.decodeUtf8 . trim
|
||||
trimQuotation = pureProc $ encodeUtf8 . Text.dropAround ('"' ==) . decodeUtf8 . trim
|
||||
|
||||
main = do
|
||||
[sources, channel] <- getArgs
|
||||
|
|
22
lib/test.nix
22
lib/test.nix
|
@ -7,11 +7,11 @@ in rec {
|
|||
getNivPath dir name = get_niv_path ([i|#{dir :: String}/nix/sources.nix|] :: String) name |> captureTrim
|
||||
|
||||
getNivAssign dir name = process <$> getNivPath dir name
|
||||
where process str = ["-I" :: String, [i|#{name :: String}=#{str :: LBS.ByteString}|]]
|
||||
where process str = ["-I" :: String, [i|#{name :: String}=#{str :: LByteString}|]]
|
||||
|
||||
main = do
|
||||
(configDir:hostname:args) <- getArgs
|
||||
paths <- concat <$> mapM (getNivAssign $ unpack configDir) ["nixpkgs", "unstable", "home-manager"]
|
||||
paths <- concat <$> mapM (getNivAssign $ toString configDir) ["nixpkgs", "unstable", "home-manager"]
|
||||
putStrLn [i|Trying to build ${name} config for #{hostname}|]
|
||||
${commandline}
|
||||
'';
|
||||
|
@ -21,14 +21,14 @@ in rec {
|
|||
name = "test-system-config";
|
||||
inherit bins;
|
||||
} (haskellBody "system" ''
|
||||
nix $ ["build", "-f", "<nixpkgs/nixos>", "system"] ++ paths ++ ["-I", [i|nixos-config=#{configDir}/hosts/#{hostname}/configuration.nix|], "-o", [i|result-system-#{hostname}|]] ++ fmap unpack args
|
||||
nix $ ["build", "-f", "<nixpkgs/nixos>", "system"] ++ paths ++ ["-I", [i|nixos-config=#{configDir}/hosts/#{hostname}/configuration.nix|], "-o", [i|result-system-#{hostname}|]] ++ fmap toString args
|
||||
'');
|
||||
|
||||
test-home-config = writeHaskellScript {
|
||||
name = "test-home-config";
|
||||
inherit bins;
|
||||
} (haskellBody "home" ''
|
||||
nix $ ["build", "-f", "<home-manager/home-manager/home-manager.nix>"] ++ paths ++ ["--argstr", "confPath", [i|#{configDir}/hosts/#{hostname}/home.nix|], "--argstr", "confAttr", "", "--out-link", [i|result-home-manager-#{hostname}|], "activationPackage"] ++ fmap unpack args
|
||||
nix $ ["build", "-f", "<home-manager/home-manager/home-manager.nix>"] ++ paths ++ ["--argstr", "confPath", [i|#{configDir}/hosts/#{hostname}/home.nix|], "--argstr", "confAttr", "", "--out-link", [i|result-home-manager-#{hostname}|], "activationPackage"] ++ fmap toString args
|
||||
'');
|
||||
|
||||
repoSrc = "git@hera.m-0.eu:nixos-config";
|
||||
|
@ -39,19 +39,17 @@ in rec {
|
|||
test-config = writeHaskellScript {
|
||||
name = "test-config";
|
||||
bins = [ test-system-config test-home-config pkgs.git niv pkgs.git-crypt ];
|
||||
imports = [
|
||||
"System.Directory (withCurrentDirectory)"
|
||||
"Control.Monad (when, ap)"
|
||||
"Data.Maybe (listToMaybe)"
|
||||
];
|
||||
imports = [ "System.Directory (withCurrentDirectory)" ];
|
||||
} ''
|
||||
checkout :: IO FilePath
|
||||
checkout = (mktemp "-d" |> captureTrim)
|
||||
>>= ((ap (<$) $ git "clone" "${repoSrc}") . LBSC.unpack)
|
||||
checkout = do
|
||||
(decodeUtf8 -> dir) <- mktemp "-d" |> captureTrim
|
||||
git "clone" "${repoSrc}" dir
|
||||
pure dir
|
||||
|
||||
main = do
|
||||
path <- pwd |> captureTrim
|
||||
bump <- (maybe False (== pack "bump") . listToMaybe) <$> getArgs
|
||||
bump <- (maybe False (== "bump") . listToMaybe) <$> getArgs
|
||||
bracket checkout (rm "-rf") $ \dir -> do
|
||||
withCurrentDirectory dir $ do
|
||||
mapM_ (\x -> git_crypt "unlock" ([i|${configPath}/.git/git-crypt/keys/#{x}|] :: String)) ${
|
||||
|
|
|
@ -9,11 +9,11 @@ in {
|
|||
getNivPath name = get_niv_path "${configPath}/nix/sources.nix" name |> captureTrim
|
||||
|
||||
getNivAssign name = tag <$> getNivPath name
|
||||
where tag str = ["-I", [i|#{name :: String}=#{str :: LBS.ByteString}|]] :: [String]
|
||||
where tag str = ["-I", [i|#{name :: String}=#{str :: LByteString}|]] :: [String]
|
||||
|
||||
main = do
|
||||
args <- getArgs
|
||||
paths <- concat <$> mapM getNivAssign ["home-manager", "nixpkgs", "unstable"]
|
||||
home_manager $ paths ++ ["switch"] ++ fmap unpack args
|
||||
home_manager $ paths ++ ["switch"] ++ fmap toString args
|
||||
'';
|
||||
}
|
||||
|
|
|
@ -11,11 +11,11 @@ in rec {
|
|||
getNivPath name = get_niv_path "${configPath}/nix/sources.nix" name |> captureTrim
|
||||
|
||||
getNivAssign name = tag <$> getNivPath name
|
||||
where tag str = ["-I" :: String, [i|#{name :: String}=#{str :: LBS.ByteString}|]]
|
||||
where tag str = ["-I" :: String, [i|#{name :: String}=#{str :: LByteString}|]]
|
||||
|
||||
main = do
|
||||
paths <- fmap concat . mapM getNivAssign $ ["nixpkgs", "unstable", "home-manager"]
|
||||
args <- getArgs
|
||||
nixos_rebuild (paths ++ ["switch"] ++ fmap unpack args)
|
||||
nixos_rebuild (paths ++ ["switch"] ++ fmap toString args)
|
||||
'';
|
||||
}
|
||||
|
|
|
@ -89,15 +89,14 @@ in rec {
|
|||
gw2wrapper = writeHaskellScript {
|
||||
name = "gw2wrapper";
|
||||
bins = [ pkgs.procps ];
|
||||
imports =
|
||||
[ "System.Directory (withCurrentDirectory)" "Control.Monad (when)" ];
|
||||
imports = [ "System.Directory (withCurrentDirectory)" ];
|
||||
|
||||
} ''
|
||||
waitForExit = do
|
||||
sleep "5s"
|
||||
processes <- ps "aux" |> captureTrim
|
||||
when
|
||||
(BSC.isInfixOf (BSC.pack "GW2.exe") (LBSC.toStrict processes))
|
||||
(BS.isInfixOf (encodeUtf8 "GW2.exe") (toStrict processes))
|
||||
waitForExit
|
||||
main = do
|
||||
withCurrentDirectory "/home/maralorn/GW2" $ exe "./play.sh"
|
||||
|
|
Loading…
Reference in a new issue