1
0
Fork 0

Switch to relude

This commit is contained in:
Malte Brandy 2020-01-19 17:40:02 +01:00
parent 522deabe83
commit 74c287a996
No known key found for this signature in database
GPG key ID: 226A2D41EF5378C9
8 changed files with 45 additions and 50 deletions

View file

@ -44,7 +44,7 @@ let
batteryLevel <- maybe (fail "Couldnt 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")

View file

@ -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" ]; };
};
};

View file

@ -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" = {

View file

@ -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

View file

@ -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)) ${

View file

@ -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
'';
}

View file

@ -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)
'';
}

View file

@ -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"