chore(users/Profpatsch/*): more cabal maintenance
Change-Id: Ib1714abce2815873eb50dbeac088e812fa9098ab Reviewed-on: https://cl.tvl.fyi/c/depot/+/8686 Tested-by: BuildkiteCI Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de>
This commit is contained in:
parent
ee21f725a3
commit
8c4730c433
24 changed files with 264 additions and 203 deletions
|
@ -1,20 +1,17 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module ArglibNetencode where
|
||||
|
||||
import qualified Data.Attoparsec.ByteString as Atto
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Attoparsec.ByteString qualified as Atto
|
||||
import ExecHelpers
|
||||
import MyPrelude
|
||||
import Netencode
|
||||
import qualified System.Environment as Env
|
||||
import qualified System.Posix.Env.ByteString as ByteEnv
|
||||
import Label
|
||||
import Netencode qualified
|
||||
import PossehlAnalyticsPrelude
|
||||
import System.Posix.Env.ByteString qualified as ByteEnv
|
||||
|
||||
arglibNetencode :: CurrentProgramName -> Maybe Text -> IO T
|
||||
arglibNetencode :: CurrentProgramName -> Maybe (Label "arglibEnvvar" Text) -> IO Netencode.T
|
||||
arglibNetencode progName mEnvvar = do
|
||||
let envvar = mEnvvar & fromMaybe "ARGLIB_NETENCODE" & textToBytesUtf8
|
||||
let envvar = mEnvvar <&> (.arglibEnvvar) & fromMaybe "ARGLIB_NETENCODE" & textToBytesUtf8
|
||||
ByteEnv.getEnv envvar >>= \case
|
||||
Nothing -> dieUserError progName [fmt|could not read args, envvar {envvar} not set|]
|
||||
Just bytes ->
|
||||
|
|
|
@ -1,17 +1,65 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: arglib-netencode
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
maintainer: mail@profpatsch.de
|
||||
|
||||
common common-options
|
||||
ghc-options:
|
||||
-Wall
|
||||
-Wno-type-defaults
|
||||
-Wunused-packages
|
||||
-Wredundant-constraints
|
||||
-fwarn-missing-deriving-strategies
|
||||
|
||||
-- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html
|
||||
-- for a description of all these extensions
|
||||
default-extensions:
|
||||
-- Infer Applicative instead of Monad where possible
|
||||
ApplicativeDo
|
||||
|
||||
-- Allow literal strings to be Text
|
||||
OverloadedStrings
|
||||
|
||||
-- Syntactic sugar improvements
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
|
||||
-- Makes the (deprecated) usage of * instead of Data.Kind.Type an error
|
||||
NoStarIsType
|
||||
|
||||
-- Convenient and crucial to deal with ambiguous field names, commonly
|
||||
-- known as RecordDotSyntax
|
||||
OverloadedRecordDot
|
||||
|
||||
-- does not export record fields as functions, use OverloadedRecordDot to access instead
|
||||
NoFieldSelectors
|
||||
|
||||
-- Record punning
|
||||
RecordWildCards
|
||||
|
||||
-- Improved Deriving
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
|
||||
-- Type-level strings
|
||||
DataKinds
|
||||
|
||||
-- to enable the `type` keyword in import lists (ormolu uses this automatically)
|
||||
ExplicitNamespaces
|
||||
|
||||
default-language: GHC2021
|
||||
|
||||
|
||||
library
|
||||
import: common-options
|
||||
exposed-modules: ArglibNetencode
|
||||
|
||||
build-depends:
|
||||
base >=4.15 && <5,
|
||||
my-prelude,
|
||||
pa-prelude,
|
||||
pa-label,
|
||||
netencode,
|
||||
exec-helpers,
|
||||
attoparsec,
|
||||
unix
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -57,7 +57,9 @@ let
|
|||
];
|
||||
|
||||
libraryHaskellDepends = [
|
||||
depot.users.Profpatsch.my-prelude
|
||||
pkgs.haskellPackages.pa-prelude
|
||||
pkgs.haskellPackages.pa-label
|
||||
pkgs.haskellPackages.pa-error-tree
|
||||
depot.users.Profpatsch.netencode.netencode-hs
|
||||
depot.users.Profpatsch.execline.exec-helpers-hs
|
||||
];
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
packages:
|
||||
./my-prelude/my-prelude.cabal
|
||||
./netencode/netencode.cabal
|
||||
./arglib/arglib-netencode.cabal
|
||||
./execline/exec-helpers.cabal
|
||||
./htmx-experiment/htmx-experiment.cabal
|
||||
./cas-serve/cas-serve.cabal
|
||||
./jbovlaste-sqlite/jbovlaste-sqlite.cabal
|
||||
|
|
|
@ -1,16 +1,9 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import ArglibNetencode (arglibNetencode)
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import Crypto.Hash qualified as Crypto
|
||||
|
@ -20,7 +13,6 @@ import Data.ByteString.Lazy qualified as Lazy
|
|||
import Data.Functor.Compose
|
||||
import Data.Int (Int64)
|
||||
import Data.List qualified as List
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.IO qualified as Text
|
||||
import Database.SQLite.Simple (NamedParam ((:=)))
|
||||
|
@ -28,12 +20,29 @@ import Database.SQLite.Simple qualified as Sqlite
|
|||
import Database.SQLite.Simple.FromField qualified as Sqlite
|
||||
import Database.SQLite.Simple.QQ qualified as Sqlite
|
||||
import Label
|
||||
import MyPrelude
|
||||
import Netencode.Parse qualified as Net
|
||||
import Network.HTTP.Types qualified as Http
|
||||
import Network.Wai qualified as Wai
|
||||
import Network.Wai.Handler.Warp qualified as Warp
|
||||
import PossehlAnalyticsPrelude
|
||||
import System.IO (stderr)
|
||||
|
||||
parseArglib = do
|
||||
let env = label @"arglibEnvvar" "CAS_SERVE_ARGS"
|
||||
let asApi =
|
||||
Net.asRecord >>> do
|
||||
address <- label @"bindToAddress" <$> (Net.key "bindToAddress" >>> Net.asText)
|
||||
port <- label @"port" <$> (Net.key "port" >>> Net.asText)
|
||||
pure (T2 address port)
|
||||
arglibNetencode "cas-serve" (Just env)
|
||||
<&> Net.runParse
|
||||
[fmt|Cannot parse arguments in "{env.arglibEnvvar}"|]
|
||||
( Net.asRecord >>> do
|
||||
publicApi <- label @"publicApi" <$> (Net.key "publicApi" >>> asApi)
|
||||
privateApi <- label @"privateApi" <$> (Net.key "privateApi" >>> asApi)
|
||||
pure $ T2 publicApi privateApi
|
||||
)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
withEnv $ \env ->
|
||||
|
@ -64,8 +73,7 @@ api env req respond = do
|
|||
Wai.responseLBS
|
||||
Http.status200
|
||||
headers
|
||||
( body & toLazyBytes
|
||||
)
|
||||
(body & toLazyBytes)
|
||||
|
||||
data Env = Env
|
||||
{ envWordlist :: Sqlite.Connection,
|
||||
|
@ -102,7 +110,7 @@ getById = handler $ \(req, env) -> do
|
|||
"size"
|
||||
Int
|
||||
)
|
||||
(env & envData)
|
||||
(env.envData)
|
||||
[Sqlite.sql|
|
||||
SELECT
|
||||
mimetype,
|
||||
|
@ -172,7 +180,7 @@ insertById = handler $ \(req, env) -> do
|
|||
name <- getNameFromWordlist env
|
||||
let fullname = name <> extension
|
||||
|
||||
let conn = env & envData
|
||||
let conn = env.envData
|
||||
Sqlite.withTransaction conn $ do
|
||||
Sqlite.executeNamed
|
||||
conn
|
||||
|
@ -218,7 +226,7 @@ getNameFromWordlist env =
|
|||
do
|
||||
let numberOfWords = 3 :: Int
|
||||
Sqlite.queryNamed @(Sqlite.Only Text)
|
||||
(env & envWordlist)
|
||||
(env.envWordlist)
|
||||
[Sqlite.sql|SELECT word FROM wordlist ORDER BY RANDOM() LIMIT :words|]
|
||||
[":words" Sqlite.:= numberOfWords]
|
||||
<&> map Sqlite.fromOnly
|
||||
|
|
|
@ -1,23 +1,74 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: cas-serve
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
maintainer: mail@profpatsch.de
|
||||
|
||||
common common-options
|
||||
ghc-options:
|
||||
-Wall
|
||||
-Wno-type-defaults
|
||||
-Wunused-packages
|
||||
-Wredundant-constraints
|
||||
-fwarn-missing-deriving-strategies
|
||||
|
||||
-- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html
|
||||
-- for a description of all these extensions
|
||||
default-extensions:
|
||||
-- Infer Applicative instead of Monad where possible
|
||||
ApplicativeDo
|
||||
|
||||
-- Allow literal strings to be Text
|
||||
OverloadedStrings
|
||||
|
||||
-- Syntactic sugar improvements
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
|
||||
-- Makes the (deprecated) usage of * instead of Data.Kind.Type an error
|
||||
NoStarIsType
|
||||
|
||||
-- Convenient and crucial to deal with ambiguous field names, commonly
|
||||
-- known as RecordDotSyntax
|
||||
OverloadedRecordDot
|
||||
|
||||
-- does not export record fields as functions, use OverloadedRecordDot to access instead
|
||||
NoFieldSelectors
|
||||
|
||||
-- Record punning
|
||||
RecordWildCards
|
||||
|
||||
-- Improved Deriving
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
|
||||
-- Type-level strings
|
||||
DataKinds
|
||||
|
||||
-- to enable the `type` keyword in import lists (ormolu uses this automatically)
|
||||
ExplicitNamespaces
|
||||
|
||||
default-language: GHC2021
|
||||
|
||||
|
||||
executable cas-serve
|
||||
import: common-options
|
||||
|
||||
main-is: CasServe.hs
|
||||
|
||||
build-depends:
|
||||
base >=4.15 && <5,
|
||||
pa-prelude,
|
||||
pa-label,
|
||||
arglib-netencode,
|
||||
netencode,
|
||||
text,
|
||||
sqlite-simple,
|
||||
http-types,
|
||||
ihp-hsx,
|
||||
wai,
|
||||
warp,
|
||||
mtl,
|
||||
my-prelude,
|
||||
bytestring,
|
||||
memory,
|
||||
cryptonite,
|
||||
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -1,17 +1,38 @@
|
|||
{ depot, pkgs, lib, ... }:
|
||||
|
||||
let
|
||||
cas-serve = pkgs.writers.writeHaskell "cas-serve"
|
||||
{
|
||||
libraries = [
|
||||
pkgs.haskellPackages.wai
|
||||
pkgs.haskellPackages.warp
|
||||
pkgs.haskellPackages.sqlite-simple
|
||||
depot.users.Profpatsch.my-prelude
|
||||
];
|
||||
ghcArgs = [ "-threaded" ];
|
||||
bins = depot.nix.getBins pkgs.sqlite [ "sqlite3" ];
|
||||
|
||||
} ./CasServe.hs;
|
||||
cas-serve = pkgs.haskellPackages.mkDerivation {
|
||||
pname = "cas-serve";
|
||||
version = "0.1.0";
|
||||
|
||||
src = depot.users.Profpatsch.exactSource ./. [
|
||||
./cas-serve.cabal
|
||||
./CasServe.hs
|
||||
];
|
||||
|
||||
libraryHaskellDepends = [
|
||||
pkgs.haskellPackages.pa-prelude
|
||||
pkgs.haskellPackages.pa-label
|
||||
pkgs.haskellPackages.ihp-hsx
|
||||
pkgs.haskellPackages.wai
|
||||
pkgs.haskellPackages.warp
|
||||
pkgs.haskellPackages.sqlite-simple
|
||||
depot.users.Profpatsch.arglib.netencode.haskell
|
||||
depot.users.Profpatsch.netencode.netencode-hs
|
||||
];
|
||||
|
||||
isExecutable = true;
|
||||
isLibrary = false;
|
||||
license = lib.licenses.mit;
|
||||
};
|
||||
|
||||
create-cas-database = depot.nix.writeExecline "create-cas-database" { readNArgs = 1; } [
|
||||
bins.sqlite3
|
||||
"$1"
|
||||
"-init"
|
||||
./schema.sql
|
||||
];
|
||||
in
|
||||
cas-serve
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: exec-helpers
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
|
|
|
@ -2,10 +2,19 @@ cradle:
|
|||
cabal:
|
||||
- path: "./my-prelude"
|
||||
component: "lib:my-prelude"
|
||||
- path: "./netencode"
|
||||
component: "lib:netencode"
|
||||
- path: "./arglib"
|
||||
component: "lib:arglib-netencode"
|
||||
- path: "./execline"
|
||||
component: "lib:exec-helpers"
|
||||
- path: "./htmx-experiment/src"
|
||||
component: "lib:htmx-experiment"
|
||||
- path: "./htmx-experiment/src"
|
||||
component: "lib:htmx-experiment"
|
||||
- path: "./htmx-experiment/Main.hs"
|
||||
component: "htmx-experiment:exe:htmx-experiment"
|
||||
|
||||
- path: "./cas-serve/CasServe.hs"
|
||||
component: "cas-serve:exe:cas-serve"
|
||||
- path: "./jbovlaste-sqlite/JbovlasteSqlite.hs"
|
||||
component: "jbovlaste-sqlite:exe:jbovlaste-sqlite"
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: htmx-experiment
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: ical-smolify
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
|
|
|
@ -4,7 +4,7 @@ module AesonQQ where
|
|||
|
||||
import Data.Aeson qualified as Json
|
||||
import Data.Either qualified as Either
|
||||
import MyPrelude
|
||||
import PossehlAnalyticsPrelude
|
||||
import PyF qualified
|
||||
import PyF.Internal.QQ qualified as PyFConf
|
||||
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NoFieldSelectors #-}
|
||||
|
@ -24,7 +25,7 @@ import Data.Aeson.KeyMap qualified as KeyMap
|
|||
import Data.ByteString qualified as ByteString
|
||||
import Data.ByteString.Lazy qualified as Lazy
|
||||
import Data.Char qualified as Char
|
||||
import Data.Error.Tree
|
||||
import "pa-error-tree" Data.Error.Tree
|
||||
import Data.Functor.Compose
|
||||
import Data.List qualified as List
|
||||
import Data.Map.Strict qualified as Map
|
||||
|
@ -32,11 +33,11 @@ import Data.Text qualified as Text
|
|||
import ExecHelpers
|
||||
import GHC.Records (HasField (..))
|
||||
import Label
|
||||
import MyPrelude
|
||||
import Netencode qualified
|
||||
import Netencode.Parse qualified as NetParse
|
||||
import Network.HTTP.Conduit qualified as Client
|
||||
import Network.HTTP.Simple qualified as Client
|
||||
import PossehlAnalyticsPrelude
|
||||
import Pretty
|
||||
import System.Directory qualified as File
|
||||
import System.Environment qualified as Env
|
||||
|
|
|
@ -16,6 +16,8 @@ let
|
|||
depot.users.Profpatsch.execline.exec-helpers-hs
|
||||
depot.users.Profpatsch.arglib.netencode.haskell
|
||||
pkgs.haskellPackages.pa-prelude
|
||||
pkgs.haskellPackages.pa-label
|
||||
pkgs.haskellPackages.pa-error-tree
|
||||
pkgs.haskellPackages.aeson
|
||||
pkgs.haskellPackages.http-conduit
|
||||
pkgs.haskellPackages.aeson-better-errors
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: mailbox-org
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
|
@ -10,7 +10,9 @@ executable mailbox-org
|
|||
build-depends:
|
||||
base >=4.15 && <5,
|
||||
my-prelude,
|
||||
pa-prelude,
|
||||
pa-label,
|
||||
pa-error-tree,
|
||||
exec-helpers,
|
||||
netencode,
|
||||
text,
|
||||
|
|
|
@ -1,113 +0,0 @@
|
|||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GHC2021 #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
|
||||
module Data.Error.Tree where
|
||||
|
||||
import Data.String (IsString (..))
|
||||
import Data.Tree qualified as Tree
|
||||
import MyPrelude
|
||||
|
||||
-- | A tree of 'Error's, with a single root 'Error' and 0..n nested 'ErrorTree's.
|
||||
--
|
||||
-- @@
|
||||
-- top error
|
||||
-- |
|
||||
-- |-- error 1
|
||||
-- | |
|
||||
-- | -- error 1.1
|
||||
-- |
|
||||
-- |-- error 2
|
||||
-- @@
|
||||
newtype ErrorTree = ErrorTree {unErrorTree :: (Tree.Tree Error)}
|
||||
deriving stock (Show)
|
||||
|
||||
instance IsString ErrorTree where
|
||||
fromString = singleError . fromString
|
||||
|
||||
-- deriving newtype (Ord) -- TODO: Add this instance with containers-0.6.5
|
||||
|
||||
-- | Turn a single 'Error' into an 'ErrorTree', a leaf.
|
||||
singleError :: Error -> ErrorTree
|
||||
singleError e = ErrorTree $ Tree.Node e []
|
||||
|
||||
-- | Take a list of errors & create a new 'ErrorTree' with the given 'Error' as the root.
|
||||
errorTree :: Error -> NonEmpty Error -> ErrorTree
|
||||
errorTree topLevelErr nestedErrs =
|
||||
ErrorTree
|
||||
( Tree.Node
|
||||
topLevelErr
|
||||
(nestedErrs <&> (\e -> Tree.Node e []) & toList)
|
||||
)
|
||||
|
||||
-- | Attach more context to the root 'Error' of the 'ErrorTree', via 'errorContext'.
|
||||
errorTreeContext :: Text -> ErrorTree -> ErrorTree
|
||||
errorTreeContext context (ErrorTree tree) =
|
||||
ErrorTree $
|
||||
tree
|
||||
{ Tree.rootLabel = tree.rootLabel & errorContext context
|
||||
}
|
||||
|
||||
-- | Nest the given 'Error' around the ErrorTree
|
||||
--
|
||||
-- @@
|
||||
-- top level error
|
||||
-- |
|
||||
-- -- nestedError
|
||||
-- |
|
||||
-- -- error 1
|
||||
-- |
|
||||
-- -- error 2
|
||||
-- @@
|
||||
nestedError ::
|
||||
Error -> -- top level
|
||||
ErrorTree -> -- nested
|
||||
ErrorTree
|
||||
nestedError topLevelErr nestedErr =
|
||||
ErrorTree $
|
||||
Tree.Node
|
||||
{ Tree.rootLabel = topLevelErr,
|
||||
Tree.subForest = [nestedErr.unErrorTree]
|
||||
}
|
||||
|
||||
-- | Nest the given 'Error' around the list of 'ErrorTree's.
|
||||
--
|
||||
-- @@
|
||||
-- top level error
|
||||
-- |
|
||||
-- |- nestedError1
|
||||
-- | |
|
||||
-- | -- error 1
|
||||
-- | |
|
||||
-- | -- error 2
|
||||
-- |
|
||||
-- |- nestedError 2
|
||||
-- @@
|
||||
nestedMultiError ::
|
||||
Error -> -- top level
|
||||
NonEmpty ErrorTree -> -- nested
|
||||
ErrorTree
|
||||
nestedMultiError topLevelErr nestedErrs =
|
||||
ErrorTree $
|
||||
Tree.Node
|
||||
{ Tree.rootLabel = topLevelErr,
|
||||
Tree.subForest = nestedErrs & toList <&> (.unErrorTree)
|
||||
}
|
||||
|
||||
prettyErrorTree :: ErrorTree -> Text
|
||||
prettyErrorTree (ErrorTree tree) =
|
||||
tree
|
||||
<&> prettyError
|
||||
<&> textToString
|
||||
& Tree.drawTree
|
||||
& stringToText
|
||||
|
||||
prettyErrorTrees :: NonEmpty ErrorTree -> Text
|
||||
prettyErrorTrees forest =
|
||||
forest
|
||||
<&> (.unErrorTree)
|
||||
<&> fmap prettyError
|
||||
<&> fmap textToString
|
||||
& toList
|
||||
& Tree.drawForest
|
||||
& stringToText
|
|
@ -8,7 +8,6 @@ pkgs.haskellPackages.mkDerivation {
|
|||
./my-prelude.cabal
|
||||
./MyPrelude.hs
|
||||
./Pretty.hs
|
||||
./Data/Error/Tree.hs
|
||||
./Aeson.hs
|
||||
./RunCommand.hs
|
||||
./Test.hs
|
||||
|
@ -18,6 +17,7 @@ pkgs.haskellPackages.mkDerivation {
|
|||
|
||||
libraryHaskellDepends = [
|
||||
pkgs.haskellPackages.pa-label
|
||||
pkgs.haskellPackages.pa-error-tree
|
||||
pkgs.haskellPackages.aeson
|
||||
pkgs.haskellPackages.aeson-better-errors
|
||||
pkgs.haskellPackages.PyF
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: my-prelude
|
||||
version: 0.0.1.0
|
||||
author: Profpatsch
|
||||
|
@ -8,7 +8,6 @@ library
|
|||
exposed-modules:
|
||||
MyPrelude
|
||||
Pretty
|
||||
Data.Error.Tree
|
||||
Aeson
|
||||
RunCommand
|
||||
Test
|
||||
|
@ -21,6 +20,7 @@ library
|
|||
build-depends:
|
||||
base >=4.15 && <5
|
||||
, pa-label
|
||||
, pa-error-tree
|
||||
, aeson
|
||||
, aeson-better-errors
|
||||
, PyF
|
||||
|
|
|
@ -1,15 +1,6 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GHC2021 #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Netencode where
|
||||
|
||||
|
@ -20,15 +11,12 @@ import Data.ByteString qualified as ByteString
|
|||
import Data.ByteString.Builder (Builder)
|
||||
import Data.ByteString.Builder qualified as Builder
|
||||
import Data.ByteString.Lazy qualified as ByteString.Lazy
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Fix (Fix (Fix))
|
||||
import Data.Fix qualified as Fix
|
||||
import Data.Functor.Classes (Eq1 (liftEq))
|
||||
import Data.Int (Int16, Int32, Int64, Int8)
|
||||
import Data.List.NonEmpty (nonEmpty)
|
||||
import Data.Map.NonEmpty (NEMap)
|
||||
import Data.Map.NonEmpty qualified as NEMap
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Semigroup qualified as Semi
|
||||
import Data.String (IsString)
|
||||
import Data.Word (Word16, Word32, Word64)
|
||||
|
@ -36,7 +24,7 @@ import GHC.Exts (fromString)
|
|||
import Hedgehog qualified as Hedge
|
||||
import Hedgehog.Gen qualified as Gen
|
||||
import Hedgehog.Range qualified as Range
|
||||
import MyPrelude
|
||||
import PossehlAnalyticsPrelude
|
||||
import Text.Show.Deriving
|
||||
import Prelude hiding (sum)
|
||||
|
||||
|
@ -74,7 +62,7 @@ instance Eq1 TF where
|
|||
liftEq _ (I6 i64) (I6 i64') = i64 == i64'
|
||||
liftEq _ (Text t) (Text t') = t == t'
|
||||
liftEq _ (Bytes b) (Bytes b') = b == b'
|
||||
liftEq eq (Sum t) (Sum t') = eq (t & tagVal) (t' & tagVal)
|
||||
liftEq eq (Sum t) (Sum t') = eq (t.tagVal) (t'.tagVal)
|
||||
liftEq eq (Record m) (Record m') = liftEq eq m m'
|
||||
liftEq eq (List xs) (List xs') = liftEq eq xs xs'
|
||||
liftEq _ _ _ = False
|
||||
|
@ -292,7 +280,7 @@ netencodeParserF inner = do
|
|||
Just tags ->
|
||||
pure $
|
||||
tags
|
||||
<&> (\t -> (t & tagTag, t & tagVal))
|
||||
<&> (\t -> (t.tagTag, t.tagVal))
|
||||
-- later keys are preferred if they are duplicates, according to the standard
|
||||
& NEMap.fromList
|
||||
_ <- Atto.Char.char '}' Atto.<?> "record did not end with }"
|
||||
|
|
|
@ -1,14 +1,4 @@
|
|||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE GHC2021 #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedRecordDot #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NoFieldSelectors #-}
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
|
||||
module Netencode.Parse where
|
||||
|
||||
|
@ -23,8 +13,9 @@ import Data.Map.NonEmpty qualified as NEMap
|
|||
import Data.Semigroupoid qualified as Semigroupiod
|
||||
import Data.Semigroupoid qualified as Semigroupoid
|
||||
import Data.Text qualified as Text
|
||||
import MyPrelude
|
||||
import Label
|
||||
import Netencode qualified
|
||||
import PossehlAnalyticsPrelude
|
||||
import Prelude hiding (log)
|
||||
|
||||
newtype Parse from to
|
||||
|
|
|
@ -28,7 +28,9 @@ let
|
|||
pkgs.haskellPackages.data-fix
|
||||
pkgs.haskellPackages.bytestring
|
||||
pkgs.haskellPackages.attoparsec
|
||||
depot.users.Profpatsch.my-prelude
|
||||
pkgs.haskellPackages.pa-prelude
|
||||
pkgs.haskellPackages.pa-label
|
||||
pkgs.haskellPackages.pa-error-tree
|
||||
];
|
||||
|
||||
isLibrary = true;
|
||||
|
|
|
@ -1,25 +1,74 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: netencode
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
maintainer: mail@profpatsch.de
|
||||
|
||||
|
||||
common common-options
|
||||
ghc-options:
|
||||
-Wall
|
||||
-Wno-type-defaults
|
||||
-Wunused-packages
|
||||
-Wredundant-constraints
|
||||
-fwarn-missing-deriving-strategies
|
||||
|
||||
-- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html
|
||||
-- for a description of all these extensions
|
||||
default-extensions:
|
||||
-- Infer Applicative instead of Monad where possible
|
||||
ApplicativeDo
|
||||
|
||||
-- Allow literal strings to be Text
|
||||
OverloadedStrings
|
||||
|
||||
-- Syntactic sugar improvements
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
|
||||
-- Makes the (deprecated) usage of * instead of Data.Kind.Type an error
|
||||
NoStarIsType
|
||||
|
||||
-- Convenient and crucial to deal with ambiguous field names, commonly
|
||||
-- known as RecordDotSyntax
|
||||
OverloadedRecordDot
|
||||
|
||||
-- does not export record fields as functions, use OverloadedRecordDot to access instead
|
||||
NoFieldSelectors
|
||||
|
||||
-- Record punning
|
||||
RecordWildCards
|
||||
|
||||
-- Improved Deriving
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
|
||||
-- Type-level strings
|
||||
DataKinds
|
||||
|
||||
-- to enable the `type` keyword in import lists (ormolu uses this automatically)
|
||||
ExplicitNamespaces
|
||||
|
||||
default-language: GHC2021
|
||||
|
||||
|
||||
library
|
||||
import: common-options
|
||||
exposed-modules:
|
||||
Netencode,
|
||||
Netencode.Parse
|
||||
|
||||
build-depends:
|
||||
base >=4.15 && <5,
|
||||
pa-prelude,
|
||||
pa-label,
|
||||
pa-error-tree,
|
||||
hedgehog,
|
||||
nonempty-containers,
|
||||
deriving-compat,
|
||||
my-prelude,
|
||||
data-fix,
|
||||
bytestring,
|
||||
attoparsec,
|
||||
text,
|
||||
semigroupoids,
|
||||
selective
|
||||
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
cabal-version: 2.4
|
||||
cabal-version: 3.0
|
||||
name: reverse-haskell-deps
|
||||
version: 0.1.0.0
|
||||
author: Profpatsch
|
||||
|
|
|
@ -21,6 +21,7 @@ pkgs.mkShell {
|
|||
h.ihp-hsx
|
||||
h.PyF
|
||||
h.unliftio
|
||||
h.xml-conduit
|
||||
h.wai
|
||||
h.wai-extra
|
||||
h.warp
|
||||
|
@ -42,11 +43,8 @@ pkgs.mkShell {
|
|||
h.case-insensitive
|
||||
h.hscolour
|
||||
h.nicify-lib
|
||||
h.hspec
|
||||
h.hspec-expectations-pretty-diff
|
||||
depot.users.Profpatsch.my-prelude
|
||||
depot.users.Profpatsch.netencode.netencode-hs
|
||||
depot.users.Profpatsch.arglib.netencode.haskell
|
||||
depot.users.Profpatsch.execline.exec-helpers-hs
|
||||
]))
|
||||
|
||||
pkgs.rustup
|
||||
|
|
Loading…
Reference in a new issue