diff --git a/app/Api.hs b/4r-api/Api.hs similarity index 100% rename from app/Api.hs rename to 4r-api/Api.hs diff --git a/app/Api/Spec.hs b/4r-api/Api/Spec.hs similarity index 100% rename from app/Api/Spec.hs rename to 4r-api/Api/Spec.hs diff --git a/app/Api/Types.hs b/4r-api/Api/Types.hs similarity index 55% rename from app/Api/Types.hs rename to 4r-api/Api/Types.hs index 3cb64b2..a82ceea 100644 --- a/app/Api/Types.hs +++ b/4r-api/Api/Types.hs @@ -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 of - Right block -> printColor block - Left err -> withSgr [SetColor Foreground Vivid Red] do - putTextLnO $ "Error parsing commonmark: " <> show err - putTextLnO message diff --git a/4r-api/api.cabal b/4r-api/api.cabal new file mode 100644 index 0000000..ee02229 --- /dev/null +++ b/4r-api/api.cabal @@ -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 diff --git a/4r-feed/4r-feed.cabal b/4r-feed/4r-feed.cabal new file mode 100644 index 0000000..3d6b6dc --- /dev/null +++ b/4r-feed/4r-feed.cabal @@ -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 diff --git a/4r-feed/Main.hs b/4r-feed/Main.hs new file mode 100644 index 0000000..c841ae9 --- /dev/null +++ b/4r-feed/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Relude + +main :: IO () +main = putStrLn "Hello there" diff --git a/4r.cabal b/4r/4r.cabal similarity index 94% rename from 4r.cabal rename to 4r/4r.cabal index 2af19fb..a5ceb94 100644 --- a/4r.cabal +++ b/4r/4r.cabal @@ -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 diff --git a/4r/Api/Color.hs b/4r/Api/Color.hs new file mode 100644 index 0000000..63d98cc --- /dev/null +++ b/4r/Api/Color.hs @@ -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 of + Right block -> printColor block + Left err -> withSgr [SetColor Foreground Vivid Red] do + putTextLnO $ "Error parsing commonmark: " <> show err + putTextLnO message diff --git a/app/Cli.hs b/4r/Cli.hs similarity index 100% rename from app/Cli.hs rename to 4r/Cli.hs diff --git a/app/Color/Print.hs b/4r/Color/Print.hs similarity index 100% rename from app/Color/Print.hs rename to 4r/Color/Print.hs diff --git a/app/Color/Utils.hs b/4r/Color/Utils.hs similarity index 100% rename from app/Color/Utils.hs rename to 4r/Color/Utils.hs diff --git a/app/Main.hs b/4r/Main.hs similarity index 99% rename from app/Main.hs rename to 4r/Main.hs index d397736..67fa1b8 100644 --- a/app/Main.hs +++ b/4r/Main.hs @@ -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 diff --git a/app/Polysemy/Commonmark/AST.hs b/4r/Polysemy/Commonmark/AST.hs similarity index 100% rename from app/Polysemy/Commonmark/AST.hs rename to 4r/Polysemy/Commonmark/AST.hs diff --git a/app/Polysemy/Output/IO.hs b/4r/Polysemy/Output/IO.hs similarity index 100% rename from app/Polysemy/Output/IO.hs rename to 4r/Polysemy/Output/IO.hs diff --git a/app/Polysemy/Sgr.hs b/4r/Polysemy/Sgr.hs similarity index 100% rename from app/Polysemy/Sgr.hs rename to 4r/Polysemy/Sgr.hs diff --git a/flake.nix b/flake.nix index 552e15c..a112a14 100644 --- a/flake.nix +++ b/flake.nix @@ -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 $? ''; });