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:
Profpatsch 2023-05-28 20:58:20 +02:00 committed by clbot
parent ee21f725a3
commit 8c4730c433
24 changed files with 264 additions and 203 deletions

View file

@ -1,20 +1,17 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module ArglibNetencode where module ArglibNetencode where
import qualified Data.Attoparsec.ByteString as Atto import Data.Attoparsec.ByteString qualified as Atto
import Data.Maybe (fromMaybe)
import ExecHelpers import ExecHelpers
import MyPrelude import Label
import Netencode import Netencode qualified
import qualified System.Environment as Env import PossehlAnalyticsPrelude
import qualified System.Posix.Env.ByteString as ByteEnv 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 arglibNetencode progName mEnvvar = do
let envvar = mEnvvar & fromMaybe "ARGLIB_NETENCODE" & textToBytesUtf8 let envvar = mEnvvar <&> (.arglibEnvvar) & fromMaybe "ARGLIB_NETENCODE" & textToBytesUtf8
ByteEnv.getEnv envvar >>= \case ByteEnv.getEnv envvar >>= \case
Nothing -> dieUserError progName [fmt|could not read args, envvar {envvar} not set|] Nothing -> dieUserError progName [fmt|could not read args, envvar {envvar} not set|]
Just bytes -> Just bytes ->

View file

@ -1,17 +1,65 @@
cabal-version: 2.4 cabal-version: 3.0
name: arglib-netencode name: arglib-netencode
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch
maintainer: mail@profpatsch.de 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 library
import: common-options
exposed-modules: ArglibNetencode exposed-modules: ArglibNetencode
build-depends: build-depends:
base >=4.15 && <5, base >=4.15 && <5,
my-prelude, pa-prelude,
pa-label,
netencode, netencode,
exec-helpers, exec-helpers,
attoparsec, attoparsec,
unix unix
default-language: Haskell2010

View file

@ -57,7 +57,9 @@ let
]; ];
libraryHaskellDepends = [ 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.netencode.netencode-hs
depot.users.Profpatsch.execline.exec-helpers-hs depot.users.Profpatsch.execline.exec-helpers-hs
]; ];

View file

@ -1,3 +1,8 @@
packages: packages:
./my-prelude/my-prelude.cabal ./my-prelude/my-prelude.cabal
./netencode/netencode.cabal
./arglib/arglib-netencode.cabal
./execline/exec-helpers.cabal
./htmx-experiment/htmx-experiment.cabal ./htmx-experiment/htmx-experiment.cabal
./cas-serve/cas-serve.cabal
./jbovlaste-sqlite/jbovlaste-sqlite.cabal

View file

@ -1,16 +1,9 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
module Main where module Main where
import ArglibNetencode (arglibNetencode)
import Control.Applicative import Control.Applicative
import Control.Monad.Reader import Control.Monad.Reader
import Crypto.Hash qualified as Crypto import Crypto.Hash qualified as Crypto
@ -20,7 +13,6 @@ import Data.ByteString.Lazy qualified as Lazy
import Data.Functor.Compose import Data.Functor.Compose
import Data.Int (Int64) import Data.Int (Int64)
import Data.List qualified as List import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text import Data.Text qualified as Text
import Data.Text.IO qualified as Text import Data.Text.IO qualified as Text
import Database.SQLite.Simple (NamedParam ((:=))) 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.FromField qualified as Sqlite
import Database.SQLite.Simple.QQ qualified as Sqlite import Database.SQLite.Simple.QQ qualified as Sqlite
import Label import Label
import MyPrelude import Netencode.Parse qualified as Net
import Network.HTTP.Types qualified as Http import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Wai import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import PossehlAnalyticsPrelude
import System.IO (stderr) 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 :: IO ()
main = do main = do
withEnv $ \env -> withEnv $ \env ->
@ -64,8 +73,7 @@ api env req respond = do
Wai.responseLBS Wai.responseLBS
Http.status200 Http.status200
headers headers
( body & toLazyBytes (body & toLazyBytes)
)
data Env = Env data Env = Env
{ envWordlist :: Sqlite.Connection, { envWordlist :: Sqlite.Connection,
@ -102,7 +110,7 @@ getById = handler $ \(req, env) -> do
"size" "size"
Int Int
) )
(env & envData) (env.envData)
[Sqlite.sql| [Sqlite.sql|
SELECT SELECT
mimetype, mimetype,
@ -172,7 +180,7 @@ insertById = handler $ \(req, env) -> do
name <- getNameFromWordlist env name <- getNameFromWordlist env
let fullname = name <> extension let fullname = name <> extension
let conn = env & envData let conn = env.envData
Sqlite.withTransaction conn $ do Sqlite.withTransaction conn $ do
Sqlite.executeNamed Sqlite.executeNamed
conn conn
@ -218,7 +226,7 @@ getNameFromWordlist env =
do do
let numberOfWords = 3 :: Int let numberOfWords = 3 :: Int
Sqlite.queryNamed @(Sqlite.Only Text) Sqlite.queryNamed @(Sqlite.Only Text)
(env & envWordlist) (env.envWordlist)
[Sqlite.sql|SELECT word FROM wordlist ORDER BY RANDOM() LIMIT :words|] [Sqlite.sql|SELECT word FROM wordlist ORDER BY RANDOM() LIMIT :words|]
[":words" Sqlite.:= numberOfWords] [":words" Sqlite.:= numberOfWords]
<&> map Sqlite.fromOnly <&> map Sqlite.fromOnly

View file

@ -1,23 +1,74 @@
cabal-version: 2.4 cabal-version: 3.0
name: cas-serve name: cas-serve
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch
maintainer: mail@profpatsch.de 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 executable cas-serve
import: common-options
main-is: CasServe.hs main-is: CasServe.hs
build-depends: build-depends:
base >=4.15 && <5, base >=4.15 && <5,
pa-prelude,
pa-label,
arglib-netencode,
netencode,
text, text,
sqlite-simple, sqlite-simple,
http-types, http-types,
ihp-hsx,
wai, wai,
warp, warp,
mtl, mtl,
my-prelude,
bytestring, bytestring,
memory, memory,
cryptonite, cryptonite,
default-language: Haskell2010

View file

@ -1,17 +1,38 @@
{ depot, pkgs, lib, ... }: { depot, pkgs, lib, ... }:
let let
cas-serve = pkgs.writers.writeHaskell "cas-serve" bins = depot.nix.getBins pkgs.sqlite [ "sqlite3" ];
{
libraries = [ 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.wai
pkgs.haskellPackages.warp pkgs.haskellPackages.warp
pkgs.haskellPackages.sqlite-simple pkgs.haskellPackages.sqlite-simple
depot.users.Profpatsch.my-prelude depot.users.Profpatsch.arglib.netencode.haskell
depot.users.Profpatsch.netencode.netencode-hs
]; ];
ghcArgs = [ "-threaded" ];
} ./CasServe.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 in
cas-serve cas-serve

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: exec-helpers name: exec-helpers
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch

View file

@ -2,10 +2,19 @@ cradle:
cabal: cabal:
- path: "./my-prelude" - path: "./my-prelude"
component: "lib: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" - path: "./htmx-experiment/src"
component: "lib:htmx-experiment" component: "lib:htmx-experiment"
- path: "./htmx-experiment/src" - path: "./htmx-experiment/src"
component: "lib:htmx-experiment" component: "lib:htmx-experiment"
- path: "./htmx-experiment/Main.hs" - path: "./htmx-experiment/Main.hs"
component: "htmx-experiment:exe:htmx-experiment" 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"

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: htmx-experiment name: htmx-experiment
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: ical-smolify name: ical-smolify
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch

View file

@ -4,7 +4,7 @@ module AesonQQ where
import Data.Aeson qualified as Json import Data.Aeson qualified as Json
import Data.Either qualified as Either import Data.Either qualified as Either
import MyPrelude import PossehlAnalyticsPrelude
import PyF qualified import PyF qualified
import PyF.Internal.QQ qualified as PyFConf import PyF.Internal.QQ qualified as PyFConf

View file

@ -6,6 +6,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-} {-# LANGUAGE NoFieldSelectors #-}
@ -24,7 +25,7 @@ import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteString qualified as ByteString import Data.ByteString qualified as ByteString
import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy qualified as Lazy
import Data.Char qualified as Char import Data.Char qualified as Char
import Data.Error.Tree import "pa-error-tree" Data.Error.Tree
import Data.Functor.Compose import Data.Functor.Compose
import Data.List qualified as List import Data.List qualified as List
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
@ -32,11 +33,11 @@ import Data.Text qualified as Text
import ExecHelpers import ExecHelpers
import GHC.Records (HasField (..)) import GHC.Records (HasField (..))
import Label import Label
import MyPrelude
import Netencode qualified import Netencode qualified
import Netencode.Parse qualified as NetParse import Netencode.Parse qualified as NetParse
import Network.HTTP.Conduit qualified as Client import Network.HTTP.Conduit qualified as Client
import Network.HTTP.Simple qualified as Client import Network.HTTP.Simple qualified as Client
import PossehlAnalyticsPrelude
import Pretty import Pretty
import System.Directory qualified as File import System.Directory qualified as File
import System.Environment qualified as Env import System.Environment qualified as Env

View file

@ -16,6 +16,8 @@ let
depot.users.Profpatsch.execline.exec-helpers-hs depot.users.Profpatsch.execline.exec-helpers-hs
depot.users.Profpatsch.arglib.netencode.haskell depot.users.Profpatsch.arglib.netencode.haskell
pkgs.haskellPackages.pa-prelude pkgs.haskellPackages.pa-prelude
pkgs.haskellPackages.pa-label
pkgs.haskellPackages.pa-error-tree
pkgs.haskellPackages.aeson pkgs.haskellPackages.aeson
pkgs.haskellPackages.http-conduit pkgs.haskellPackages.http-conduit
pkgs.haskellPackages.aeson-better-errors pkgs.haskellPackages.aeson-better-errors

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: mailbox-org name: mailbox-org
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch
@ -10,7 +10,9 @@ executable mailbox-org
build-depends: build-depends:
base >=4.15 && <5, base >=4.15 && <5,
my-prelude, my-prelude,
pa-prelude,
pa-label, pa-label,
pa-error-tree,
exec-helpers, exec-helpers,
netencode, netencode,
text, text,

View file

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

View file

@ -8,7 +8,6 @@ pkgs.haskellPackages.mkDerivation {
./my-prelude.cabal ./my-prelude.cabal
./MyPrelude.hs ./MyPrelude.hs
./Pretty.hs ./Pretty.hs
./Data/Error/Tree.hs
./Aeson.hs ./Aeson.hs
./RunCommand.hs ./RunCommand.hs
./Test.hs ./Test.hs
@ -18,6 +17,7 @@ pkgs.haskellPackages.mkDerivation {
libraryHaskellDepends = [ libraryHaskellDepends = [
pkgs.haskellPackages.pa-label pkgs.haskellPackages.pa-label
pkgs.haskellPackages.pa-error-tree
pkgs.haskellPackages.aeson pkgs.haskellPackages.aeson
pkgs.haskellPackages.aeson-better-errors pkgs.haskellPackages.aeson-better-errors
pkgs.haskellPackages.PyF pkgs.haskellPackages.PyF

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: my-prelude name: my-prelude
version: 0.0.1.0 version: 0.0.1.0
author: Profpatsch author: Profpatsch
@ -8,7 +8,6 @@ library
exposed-modules: exposed-modules:
MyPrelude MyPrelude
Pretty Pretty
Data.Error.Tree
Aeson Aeson
RunCommand RunCommand
Test Test
@ -21,6 +20,7 @@ library
build-depends: build-depends:
base >=4.15 && <5 base >=4.15 && <5
, pa-label , pa-label
, pa-error-tree
, aeson , aeson
, aeson-better-errors , aeson-better-errors
, PyF , PyF

View file

@ -1,15 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Netencode where module Netencode where
@ -20,15 +11,12 @@ import Data.ByteString qualified as ByteString
import Data.ByteString.Builder (Builder) import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as Builder import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy qualified as ByteString.Lazy import Data.ByteString.Lazy qualified as ByteString.Lazy
import Data.Coerce (coerce)
import Data.Fix (Fix (Fix)) import Data.Fix (Fix (Fix))
import Data.Fix qualified as Fix import Data.Fix qualified as Fix
import Data.Functor.Classes (Eq1 (liftEq)) import Data.Functor.Classes (Eq1 (liftEq))
import Data.Int (Int16, Int32, Int64, Int8) import Data.Int (Int16, Int32, Int64, Int8)
import Data.List.NonEmpty (nonEmpty)
import Data.Map.NonEmpty (NEMap) import Data.Map.NonEmpty (NEMap)
import Data.Map.NonEmpty qualified as NEMap import Data.Map.NonEmpty qualified as NEMap
import Data.Maybe (fromMaybe)
import Data.Semigroup qualified as Semi import Data.Semigroup qualified as Semi
import Data.String (IsString) import Data.String (IsString)
import Data.Word (Word16, Word32, Word64) import Data.Word (Word16, Word32, Word64)
@ -36,7 +24,7 @@ import GHC.Exts (fromString)
import Hedgehog qualified as Hedge import Hedgehog qualified as Hedge
import Hedgehog.Gen qualified as Gen import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range import Hedgehog.Range qualified as Range
import MyPrelude import PossehlAnalyticsPrelude
import Text.Show.Deriving import Text.Show.Deriving
import Prelude hiding (sum) import Prelude hiding (sum)
@ -74,7 +62,7 @@ instance Eq1 TF where
liftEq _ (I6 i64) (I6 i64') = i64 == i64' liftEq _ (I6 i64) (I6 i64') = i64 == i64'
liftEq _ (Text t) (Text t') = t == t' liftEq _ (Text t) (Text t') = t == t'
liftEq _ (Bytes b) (Bytes b') = b == b' 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 (Record m) (Record m') = liftEq eq m m'
liftEq eq (List xs) (List xs') = liftEq eq xs xs' liftEq eq (List xs) (List xs') = liftEq eq xs xs'
liftEq _ _ _ = False liftEq _ _ _ = False
@ -292,7 +280,7 @@ netencodeParserF inner = do
Just tags -> Just tags ->
pure $ pure $
tags tags
<&> (\t -> (t & tagTag, t & tagVal)) <&> (\t -> (t.tagTag, t.tagVal))
-- later keys are preferred if they are duplicates, according to the standard -- later keys are preferred if they are duplicates, according to the standard
& NEMap.fromList & NEMap.fromList
_ <- Atto.Char.char '}' Atto.<?> "record did not end with }" _ <- Atto.Char.char '}' Atto.<?> "record did not end with }"

View file

@ -1,14 +1,4 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -Wall #-}
module Netencode.Parse where 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 Semigroupiod
import Data.Semigroupoid qualified as Semigroupoid import Data.Semigroupoid qualified as Semigroupoid
import Data.Text qualified as Text import Data.Text qualified as Text
import MyPrelude import Label
import Netencode qualified import Netencode qualified
import PossehlAnalyticsPrelude
import Prelude hiding (log) import Prelude hiding (log)
newtype Parse from to newtype Parse from to

View file

@ -28,7 +28,9 @@ let
pkgs.haskellPackages.data-fix pkgs.haskellPackages.data-fix
pkgs.haskellPackages.bytestring pkgs.haskellPackages.bytestring
pkgs.haskellPackages.attoparsec pkgs.haskellPackages.attoparsec
depot.users.Profpatsch.my-prelude pkgs.haskellPackages.pa-prelude
pkgs.haskellPackages.pa-label
pkgs.haskellPackages.pa-error-tree
]; ];
isLibrary = true; isLibrary = true;

View file

@ -1,25 +1,74 @@
cabal-version: 2.4 cabal-version: 3.0
name: netencode name: netencode
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch
maintainer: mail@profpatsch.de 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 library
import: common-options
exposed-modules: exposed-modules:
Netencode, Netencode,
Netencode.Parse Netencode.Parse
build-depends: build-depends:
base >=4.15 && <5, base >=4.15 && <5,
pa-prelude,
pa-label,
pa-error-tree,
hedgehog, hedgehog,
nonempty-containers, nonempty-containers,
deriving-compat, deriving-compat,
my-prelude,
data-fix, data-fix,
bytestring, bytestring,
attoparsec, attoparsec,
text, text,
semigroupoids, semigroupoids,
selective selective
default-language: Haskell2010

View file

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.0
name: reverse-haskell-deps name: reverse-haskell-deps
version: 0.1.0.0 version: 0.1.0.0
author: Profpatsch author: Profpatsch

View file

@ -21,6 +21,7 @@ pkgs.mkShell {
h.ihp-hsx h.ihp-hsx
h.PyF h.PyF
h.unliftio h.unliftio
h.xml-conduit
h.wai h.wai
h.wai-extra h.wai-extra
h.warp h.warp
@ -42,11 +43,8 @@ pkgs.mkShell {
h.case-insensitive h.case-insensitive
h.hscolour h.hscolour
h.nicify-lib h.nicify-lib
h.hspec
h.hspec-expectations-pretty-diff 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 pkgs.rustup