Move every subproject to distinct derivation and direcrory

main
staticvoid 2022-06-30 18:22:41 +03:00
parent 8ecd2f79f5
commit 624c640cf0
16 changed files with 289 additions and 90 deletions

View File

@ -9,18 +9,13 @@ module Api.Types (
, Topic (..)
, ThreadHead (..)
, ThreadPost (..)
, threadHeadToPost
) where
import Relude
import Color.Print
import Color.Utils
import Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:))
import Data.HashMap.Strict qualified as M
import Polysemy.Commonmark.AST (commonmark)
import Polysemy.Output.IO
import Polysemy.Sgr
import System.Console.ANSI
import Web.FormUrlEncoded (Form (Form), ToForm (toForm))
data GetSections = GetSections
@ -35,14 +30,6 @@ data Section = Section
instance NFData Section
instance FromJSON Section
instance PrintColor Section where
printColor Section{id = thread_id, thread_group_name, description} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thread_group_name
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " #" <> show thread_id
putTextLnO description
data GetTopics = GetTopics
instance ToForm GetTopics where
toForm GetTopics = Form $ M.fromList [("type", ["threads"]), ("key", ["anon"])]
@ -55,16 +42,6 @@ data TopicInfo = TopicInfo
instance NFData TopicInfo
instance FromJSON TopicInfo
instance PrintColor TopicInfo where
printColor TopicInfo{id = topic_id, thrname, last_activity_date, last_activity_user} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thrname
putTextO ": "
withSgr [SetPaletteColor Foreground (textColor last_activity_user)] do
putTextO $ "@" <> last_activity_user
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " at " <> last_activity_date <> " #" <> show topic_id
data GetTopic = GetTopic {topic_id :: Integer}
instance ToForm GetTopic where
toForm GetTopic{topic_id} =
@ -83,10 +60,6 @@ data Topic = Topic
instance NFData Topic
instance FromJSON Topic
instance PrintColor Topic where
printColor Topic{thread, post} =
sequenceA_ $ intersperse (putTextLnO "") (printColor <$> threadHeadToPost thread : post)
data ThreadHead = ThreadHead
{ info :: TopicInfo
, message :: Text
@ -115,20 +88,3 @@ data ThreadPost = ThreadPost
deriving stock (Generic, Show)
instance NFData ThreadPost
instance FromJSON ThreadPost
instance PrintColor ThreadPost where
printColor ThreadPost{id = post_id, name, date, message} = do
withSgr
[ SetPaletteColor Foreground (textColor name)
, SetConsoleIntensity BoldIntensity
-- , SetSwapForegroundBackground True
]
do
putTextO $ "@" <> name
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " " <> date <> " #" <> show post_id
case commonmark "<message>" message of
Right block -> printColor block
Left err -> withSgr [SetColor Foreground Vivid Red] do
putTextLnO $ "Error parsing commonmark: " <> show err
putTextLnO message

61
4r-api/api.cabal 100644
View File

@ -0,0 +1,61 @@
cabal-version: 3.0
name: 4r-api
version: 0.1.0
author: staticvoid@mail.i2p
license: GPL-3.0-or-later
common c
default-language: GHC2021
default-extensions:
NoImplicitPrelude
NoFieldSelectors
OverloadedRecordDot
DuplicateRecordFields
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DeriveFunctor
DeriveGeneric
DerivingStrategies
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
HexFloatLiterals
ImportQualifiedPost
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
NumericUnderscores
OverloadedStrings
ScopedTypeVariables
StandaloneDeriving
TupleSections
TypeApplications
TypeOperators
TypeSynonymInstances
UndecidableInstances
ghc-options:
-Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints
-Wmissing-export-lists -Wincomplete-record-updates
-Wmissing-deriving-strategies
library
import: c
exposed-modules:
, Api
, Api.Spec
, Api.Types
hs-source-dirs: .
build-depends:
, aeson
, base
, http-api-data
, polysemy
, relude
, servant
, servant-client
, servant-polysemy

View File

@ -0,0 +1,60 @@
cabal-version: 3.0
name: 4r-feed
version: 0.1.0
author: staticvoid@mail.i2p
license: GPL-3.0-or-later
common c
default-language: GHC2021
default-extensions:
NoImplicitPrelude
NoFieldSelectors
OverloadedRecordDot
DuplicateRecordFields
BangPatterns
BinaryLiterals
BlockArguments
ConstraintKinds
DataKinds
DeriveFunctor
DeriveGeneric
DerivingStrategies
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
HexFloatLiterals
ImportQualifiedPost
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
NumericUnderscores
OverloadedStrings
ScopedTypeVariables
StandaloneDeriving
TupleSections
TypeApplications
TypeOperators
TypeSynonymInstances
UndecidableInstances
ghc-options:
-Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints
-Wmissing-export-lists -Wincomplete-record-updates
-Wmissing-deriving-strategies
executable 4r-feed
import: c
main-is: Main.hs
hs-source-dirs: .
build-depends:
, 4r-api
, ansi-terminal
, base
, commonmark
, commonmark-extensions
, optparse-applicative
, polysemy
, relude
, servant
, servant-polysemy

6
4r-feed/Main.hs 100644
View File

@ -0,0 +1,6 @@
module Main (main) where
import Relude
main :: IO ()
main = putStrLn "Hello there"

View File

@ -46,17 +46,16 @@ common c
executable 4r
import: c
main-is: Main.hs
other-modules: Api
Api.Spec
Api.Types
other-modules: Api.Color
Cli
Polysemy.Commonmark.AST
Polysemy.Output.IO
Polysemy.Sgr
Color.Print
Color.Utils
hs-source-dirs: app
hs-source-dirs: .
build-depends:
, 4r-api
, aeson
, ansi-terminal
, base

62
4r/Api/Color.hs 100644
View File

@ -0,0 +1,62 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE Strict #-}
module Api.Color (
GetSections (GetSections)
, Section (..)
, GetTopics (GetTopics)
, TopicInfo (..)
, GetTopic (..)
, Topic (..)
, ThreadHead (..)
, ThreadPost (..)
) where
import Relude
import Api.Types
import Color.Print
import Color.Utils
import Polysemy.Commonmark.AST (commonmark)
import Polysemy.Output.IO
import Polysemy.Sgr
import System.Console.ANSI
instance PrintColor Section where
printColor Section{id = thread_id, thread_group_name, description} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thread_group_name
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " #" <> show thread_id
putTextLnO description
instance PrintColor TopicInfo where
printColor TopicInfo{id = topic_id, thrname, last_activity_date, last_activity_user} = do
withSgr [SetUnderlining SingleUnderline] do
putTextO thrname
putTextO ": "
withSgr [SetPaletteColor Foreground (textColor last_activity_user)] do
putTextO $ "@" <> last_activity_user
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " at " <> last_activity_date <> " #" <> show topic_id
instance PrintColor Topic where
printColor Topic{thread, post} =
sequenceA_ $ intersperse (putTextLnO "") (printColor <$> threadHeadToPost thread : post)
instance PrintColor ThreadPost where
printColor ThreadPost{id = post_id, name, date, message} = do
withSgr
[ SetPaletteColor Foreground (textColor name)
, SetConsoleIntensity BoldIntensity
-- , SetSwapForegroundBackground True
]
do
putTextO $ "@" <> name
withSgr [SetColor Foreground Dull White] do
putTextLnO $ " " <> date <> " #" <> show post_id
case commonmark "<message>" message of
Right block -> printColor block
Left err -> withSgr [SetColor Foreground Vivid Red] do
putTextLnO $ "Error parsing commonmark: " <> show err
putTextLnO message

View File

@ -4,6 +4,7 @@ import Relude hiding (Proxy)
import Api qualified as Api
import Api.Types (last_activity_date)
import Api.Color ()
import Cli
import Color.Print
import Network.HTTP.Client

136
flake.nix
View File

@ -37,42 +37,93 @@
let pkgs = nixpkgs'.haskell.packages.${ghcVersion}.override {
overrides = (import ./nix/dependencies.nix inputs ghcVersion);
};
_4r-api = pkgs.mkDerivation {
pname = "4r-api";
version = "0.1.0";
src = ./4r-api;
isExecutable = false;
isLibrary = true;
libraryHaskellDepends = with pkgs; [
aeson
base
http-api-data
polysemy
relude
servant
servant-client
servant-polysemy
];
doHaddock = false;
doHoogle = false;
license = nixpkgs.lib.licenses.gpl3Plus;
passthru = { inherit pkgs; };
};
_4r = pkgs.mkDerivation {
pname = "4r";
version = "0.1.0";
src = ./4r;
isExecutable = true;
executableHaskellDepends = with pkgs; [
_4r-api
aeson
ansi-terminal
base
commonmark
commonmark-extensions
cryptohash-sha512
http-api-data
http-client
optparse-applicative
polysemy
relude
servant
servant-client
servant-polysemy
unordered-containers
];
license = nixpkgs.lib.licenses.gpl3Plus;
passthru = { inherit pkgs; };
};
_4r-feed = pkgs.mkDerivation {
pname = "4r-feed";
version = "0.1.0";
src = ./4r-feed;
isExecutable = true;
executableHaskellDepends = with pkgs; [
_4r-api
ansi-terminal
base
commonmark
commonmark-extensions
optparse-applicative
polysemy
relude
servant
servant-polysemy
];
license = nixpkgs.lib.licenses.gpl3Plus;
passthru = { inherit pkgs; };
};
in
pkgs.mkDerivation {
pname = "4r";
version = "0.1.0";
src = ./.;
isExecutable = true;
executableHaskellDepends = with pkgs; [
aeson
ansi-terminal
base
commonmark
commonmark-extensions
cryptohash-sha512
http-api-data
http-client
optparse-applicative
polysemy
relude
servant
servant-client
servant-polysemy
unordered-containers
];
license = nixpkgs.lib.licenses.gpl3Plus;
passthru = { inherit pkgs; };
};
{ inherit _4r _4r-api _4r-feed; };
thisNative = this "ghc922";
in
{
packages.default = thisNative;
apps.default = {
type = "app";
program = "${thisNative}/bin/4r";
packages = {
inherit thisNative;
default = thisNative._4r;
};
apps =
let binaryToApp = bin: { type = "app"; program = "${bin}/bin/${bin.pname}"; };
in
rec {
_4r = binaryToApp thisNative._4r;
_4r-feed = binaryToApp thisNative._4r-feed;
default = _4r;
};
devShells =
let unwords = nixpkgs'.lib.concatStringsSep " ";
options = [
@ -117,23 +168,26 @@
"-XTypeSynonymInstances"
"-XUndecidableInstances"
];
findFiles = "$(find app -name '*.hs')";
default = thisNative._4r.env;
ghciIn = dir: default.overrideAttrs (_: {
shellHook = ''
ghci ${unwords (options ++ extensions)} $(find ${dir} -name '*.hs')
exit $?
'';
});
in
rec {
default = thisNative.env;
ghci = default.overrideAttrs (_: {
shellHook = ''
ghci ${unwords (options ++ extensions)} ${findFiles}
exit $?
'';
});
{
inherit default;
_4r = ghciIn "4r";
_4r-api = ghciIn "4r-api";
_4r-feed = ghciIn "4r-feed";
fourmolu = default.overrideAttrs (a: {
nativeBuildInputs = a.nativeBuildInputs ++ [ thisNative.passthru.pkgs.fourmolu ];
nativeBuildInputs = a.nativeBuildInputs ++ [ thisNative._4r.passthru.pkgs.fourmolu ];
shellHook = ''
fourmolu --mode inplace \
--indentation 2 --check-idempotence --import-export-comma-style leading \
${unwords (map (e: "-o ${e}") (options ++ extensions))} \
${findFiles}
$(find . -name '*.hs')
exit $?
'';
});