Zenn
Closed15

一夜漬け PureScript

toyboot4etoyboot4e

PureScript とは

まず PureScript はどういう位置付けなのか。

https://www.purescript.org/

A strongly-typed functional programming language that compiles to JavaScript

An extensive collection of libraries for development of web applications, web servers, apps and more

Web でゴリゴリの関数型プログラミングをやるなら (Elm か) PureScript ということですね。

https://qiita.com/hiruberuto/items/c65e7629d3b1597840d9

PureScriptは、Haskellの精神を受け継いでさらに研ぎ澄ました、「HaskellよりもHaskellらしい」言語です。

Nodeを使いたいなら PureScript 一択。サーバサイドもクライアントサイドもこれ一本。

しかも相当出来が良いらしい。パッと見時代の寵児ですが、普及率はTypeScript に喰われている印象がありました。 ※ 素人視点です。

toyboot4etoyboot4e

環境構築

あまり踏襲できる流れは無かったため、地道にやって行きましょう。

PureScript

nixpkgs の purescript を入れると purs コマンドが生えました。ソースファイルの拡張子も .purs です。ついつい『パース』と読んでしまいます。

LS

言語サーバがある！　nixpkgs には無いので Node 経由で入れます。

$ npm i purescript-language-server
$ npm i purs-tidy

おいおい README に Emacs が無いぜ！　まあいつものことですね。

https://github.com/nwolverson/purescript-language-server

Emacs

デフォルトではハイライトがありません。

purescript-emacs/purescript-mode を入れるとハイライトされるようになりました。 20 Stars って、嘘だろ……？ (また Emacs が死んだ！)　みんな tree-sitter に行っちまったのか……？

(leaf purescript-mode)

エラー表示のため LSP を入れます。 Doom Emacs の modules/lang/purescript/config.el を見ると、 purescript-emacs/psc-ide-emacs パッケージもありますが、 lsp-mode だけでも良いでしょうか？

https://emacs-lsp.github.io/lsp-mode/page/lsp-purescript/

一応エラーは出るようになりました。コンパイルと実行はまだです。

toyboot4etoyboot4e

まだ何もしていないけれども

飽きてきたので二夜目に続きます……

toyboot4etoyboot4e

2 夜目

カレンダー当日です。実行方法から確認します。

spago

Getting Started では spago 推奨でした。 nixpkgs から入れて使ってみます。

$ spago init
$ tree
.
├── Main.purs
├── packages.dhall
├── spago.dhall
├── src
│   └── Main.purs
└── test
    └── Main.purs

3 directories, 5 files

ビルドに失敗します:

$ spago build
[error]
Failed to install dependency "effect"
Git output:

fatal: destination path '.' already exists and is not an empty directory.


Aborting installation..

どうも purescript-overlay を 使うと良さそうです 。僕は (なぜか) flake-utils を使っていたので、 横断検索 でヒットした jeslie0/mkSpagoDerivation に沿って導入します。

なんちゃって flake.nix
{
  description = "A basic flake with a shell";
  inputs = {
    nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
    flake-utils.url = "github:numtide/flake-utils";
     purescript-overlay = {
       url = "github:thomashoneyman/purescript-overlay";
       inputs.nixpkgs.follows = "nixpkgs";
     };
  };

  outputs = inputs@{ nixpkgs, flake-utils, ... }:
    flake-utils.lib.eachDefaultSystem (system:
      let
        pkgs = import nixpkgs {
          inherit system;
          overlays = [ inputs.purescript-overlay.overlays.default ];
        };
      in
      {
        devShells.default = with pkgs; mkShell {
          nativeBuildInputs = [
            purs
            spago-unstable
            purs-tidy-bin.purs-tidy-0_10_0
            purs-backend-es
          ];

          packages = [
            # atcoder-cli is from npm

            online-judge-tools
            python311Packages.selenium
            python311Packages.pyaml
            python311Packages.importlab
            nodejs
          ];
        };
      });
}

これでセットアップしました。

$ spago init

Hello, world!

早速動くようになりました。何気ないコードですが、すでにカッチョいい。

module Main where

import Prelude

import Effect (Effect)
import Effect.Console (log)

main :: Effect Unit
main =
  log "Hello, PureScript!"

$ spago run
Reading Spago workspace configuration...

✓ Selecting package to build: playground

Downloading dependencies...
Building...
           Src   Lib   All
Warnings     0     0     0
Errors       0     0     0

✓ Build succeeded.

Hello, PureScript!

$ spago run --quiet
           Src   Lib   All
Warnings     0     0     0
Errors       0     0     0
Hello, PureScript!

REPL

spago repl で動かせそうです。

$ spago repl
PSCi, version 0.15.15
Type :? for help

import Prelude

> map (+ 1) [1 .. 4]
Unexpected token 'map' at line 1, column 1
> import Data.List
Error found:
in module $PSCI
at <internal>:0:0 - 0:0 (line 0, column 0 - line 0, column 0)
>
  Unknown module Data.List


See https://github.com/purescript/documentation/blob/master/errors/UnknownName.md for more information,
or to contribute content related to this error.

Nix でありがちなやつ〜〜

toyboot4etoyboot4e

標準入力を捌く (1)

State ベースの簡易文字列パーサを作って行きます。

標準入力を受け取る

bouzuya/purescript-at-coder/src/ABC092A.purs を参考に、標準入力全体を受け取るコードを試してみます。まずは node-fs のインストールから。 ジャッジの JS 環境とバージョンが一致しない と思いますが、手抜きはご勘弁ください。

$ spago install node-fs

標準入力全体を文字列に読み込んでみます。

module Main where

import Prelude
import Effect (Effect)
import Effect.Console (log)
import Node.Encoding (Encoding(..))
import Node.FS.Sync as FS

main :: Effect Unit
main = do
  input <- FS.readTextFile UTF8 "/dev/stdin"
  log input

無事動きました。

$ echo stdin | spago run -q
           Src   Lib   All
Warnings     0     0     0
Errors       0     0     0
stdin

単語パーサの元となる関数を探す

Haskell で言う readInt :: ByteString -> Maybe (Int, ByteString) 相当の関数を 検索しました 。無いじゃん……！　そもそもタプルが無くてレコードを使う模様です。

ChatGPT に聞いてみたところ、 Data.Int.fromString はあるようです。 Pursuit が 503 エラーになったので、手探りで使ってみます。

$ spago install unicode

module Main where

import Prelude
import Data.CodePoint.Unicode as C
import Data.Int as Int
import Data.Maybe
import Data.String as S
import Effect (Effect)
import Effect.Console (log)
import Node.Encoding (Encoding(..))
import Node.FS.Sync as FS
import Partial.Unsafe (unsafePartial)

-- | Builtin で欲しいやつ
readInt :: String -> Maybe { n :: Int, rest :: String}
readInt str =
  let str' = S.dropWhile C.isSpace str
      -- partition :: (a -> Bool) -> [a] -> ([a], [a]) が欲しい
      digits = S.takeWhile C.isDecDigit str'
      rest = S.drop (S.length digits) str'
   in do
     -- {,rest} <$> Int.fromString digits と書きたい
     n <- Int.fromString digits
     pure { n, rest }

main :: Effect Unit
main = unsafePartial $ do
  input <- FS.readTextFile UTF8 "/dev/stdin"
  let { n, rest } = fromJust $ readInt input
  log $ show n
  log rest

非 Partial な main がエントリーポイントであるらしく、 main 自体に Partial 制約をつけると何も実行されなくなります。

toyboot4etoyboot4e

標準入力を捌く (2)

transformers の導入

正直 parsing が良さそうですが、簡易パーサを手作りします。

$ spago install transfomers

readInt (再)

Monad.State.Class を見た感じ、タプルを返した方が良かったのでそうします。

readInt :: String -> Maybe (Tuple Int String)
readInt str =
  let str' = S.dropWhile C.isSpace str
      -- partition :: (a -> Bool) -> [a] -> ([a], [a]) が欲しい
      digits = S.takeWhile C.isDecDigit str'
      rest = S.drop (S.length digits) str'
   in (\n -> {- 部分適用できず -} Tuple n rest) <$> Int.fromString digits

3 値以上のタプルは Data.Tuple.Nested のようです。 Unit で終端を表すのが面倒そうです。

int

関連の import:

import Control.Monad.State.Class

今回は partial にしてしまいました。型引数はすべて forall で書く必要があり、省略できません:

int :: forall m. Partial => MonadState String m => m Int
int = state (fromJust <$> readInt) -- `(fromJust <$>) . readInt` じゃなくて良い？？

ints2

これは合成するだけですね:

ints2 :: forall m. Partial => MonadState String m => m (Tuple Int Int)
ints2 = Tuple <$> int <*> int

ints

1 行読んで整数列に分解します。 Data.Unfoldable が型クラスになっているのが良いですね。

import Data.Unfoldable

実行:

dropSpace' :: forall m. (MonadState String m) => m Unit
dropSpace' = modify_ $ \s ->
  let len = S.length $ S.takeWhile C.isSpace s
   in S.drop len s

line :: forall m. (MonadState String m) => m String
line = do
  dropSpace'
  s <- S.takeWhile (\c -> c /= {- これ面倒です -} SC.codePointFromChar '\n') <$> get
  modify_ $ S.drop $ 1 + S.length s
  pure s

ints :: forall m. Partial => MonadState String m => m (Array Int)
ints = unfoldr readInt <$> line

実行

以上を main から利用してみます:

main' :: Partial => StateT String Effect Unit
main' = do
  Tuple n m <- ints2
  xs <- ints
  ys <- ints
  liftEffect $ log $ show (Tuple n m)
  liftEffect $ log $ "line 1: " <> show xs
  liftEffect $ log $ "line 2: " <> show ys

正しくパースできています:

input
1 2
3 4 5
6 7 8 9
output
(Tuple 1 2)
line 1: [3,4,5]
line 2: [6,7,8,9]
toyboot4etoyboot4e

ナップサック問題

なんちゃって PureScript でした。締めに Knapsack 問題を解いてみます。

https://atcoder.jp/contests/dp/tasks/dp_d

解答部分

main' :: Partial => StateT String Effect Unit
main' = do
  Tuple n wMax <- ints2
  -- この型表記は簡単にしたい
  wvs :: Array (Tuple Int Int) <- replicateA n ints2

  -- weight -> maximum value
  let arr0 = A.cons (Max 0) $ A.replicate wMax (mempty :: Max Int)
  let res = foldl step arr0 wvs
        where
          step :: Array (Max Int) -> Tuple Int Int -> Array (Max Int)
          step arr (Tuple dw dv) = A.mapWithIndex f arr
            where
              f :: Int -> Max Int -> Max Int
              f w v = case arr A.!! (w - dw) of
                Nothing -> v
                Just v' -> v <> Max (unwrap v' + dv) {- Max Int 同士は加算できない (Semiring ではない -}

  let ans = fromJust $ maximum res
  liftEffect $ log $ if ans == mempty then "-1" else show (unwrap ans)

main :: Effect Unit
main = do
  input <- FS.readTextFile UTF8 "/dev/stdin"
  unsafePartial $ evalStateT main' input

テスト実行

サンプルのみ実行します:

input
3 8
3 30
4 50
5 60

=> 90 (AC)

input
5 5
1 1000000000
1 1000000000
1 1000000000
1 1000000000
1 1000000000

=> 2000000000 (WA)

うおお、 Int が 32 bit のようです。手間だ……

toyboot4etoyboot4e

ナップサック問題の解答

だいぶ苦戦していますが、一応解けたと思います。

module Main where

import Prelude
import Control.Monad.State.Class
import Control.Monad.State.Trans
import Data.Array as A
import Data.Char as Char
import Data.CodePoint.Unicode as C
import Data.Foldable
import Data.Unfoldable
import Data.Int as Int
import Data.Int64 (Int64)
import Data.Int64 as Int64
import Data.Maybe
import Data.Newtype (unwrap)
import Data.Ord.Max
import Data.String as S
import Data.String.CodePoints as SC
import Data.Tuple
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Node.Encoding (Encoding(..))
import Node.FS.Sync as FS
import Partial.Unsafe (unsafePartial)

readInt :: String -> Maybe (Tuple Int String)
readInt str =
  let str' = S.dropWhile C.isSpace str
      -- partition :: (a -> Bool) -> [a] -> ([a], [a]) が欲しい
      digits = S.takeWhile C.isDecDigit str'
      rest = S.drop (S.length digits) str'
   in (\n -> {- 部分適用できず -} Tuple n rest) <$> Int.fromString digits

readInt64 :: String -> Maybe (Tuple Int64 String)
readInt64 str =
  let str' = S.dropWhile C.isSpace str
      -- partition :: (a -> Bool) -> [a] -> ([a], [a]) が欲しい
      digits = S.takeWhile C.isDecDigit str'
      rest = S.drop (S.length digits) str'
   in (\n -> {- 部分適用できず -} Tuple n rest) <$> Int64.fromString digits

int :: forall m. Partial => MonadState String m => m Int
int = state (fromJust <$> readInt)

int64 :: forall m. Partial => MonadState String m => m Int64
int64 = state (fromJust <$> readInt64)

ints2 :: forall m. Partial => MonadState String m => m (Tuple Int Int)
ints2 = Tuple <$> int <*> int

ints64_2 :: forall m. Partial => MonadState String m => m (Tuple Int64 Int64)
ints64_2 = Tuple <$> int64 <*> int64

dropSpace' :: forall m. (MonadState String m) => m Unit
dropSpace' = modify_ $ \s ->
  let len = S.length $ S.takeWhile C.isSpace s
   in S.drop len s

line :: forall m. (MonadState String m) => m String
line = do
  dropSpace'
  s <- S.takeWhile (\c -> c /= {- これ面倒です -} SC.codePointFromChar '\n') <$> get
  modify_ $ S.drop $ 1 + S.length s
  pure s

int64s :: forall m. Partial => MonadState String m => m (Array Int64)
int64s = unfoldr readInt64 <$> line

main' :: Partial => StateT String Effect Unit
main' = do
  Tuple n wMax <- ints2
  -- この型表記は簡単にしたい
  wvs :: Array (Tuple Int Int64) <- replicateA n (Tuple <$> int <*> int64)

  -- weight -> maximum value
  let arr0 = A.cons (Max (Int64.fromInt 0)) $ A.replicate wMax (mempty :: Max Int64)
  let res = foldl step arr0 wvs
        where
          step :: Array (Max Int64) -> Tuple Int Int64 -> Array (Max Int64)
          step arr (Tuple dw dv) = A.mapWithIndex f arr
            where
              f :: Int -> Max Int64 -> Max Int64
              f w v = case arr A.!! (w - dw) of
                Nothing -> v
                Just v' -> v <> Max (unwrap v' + dv) {- Max Int64 同士は加算できない (Semiring ではない) -}

  -- liftEffect $ log $ show res
  let ans = fromJust $ maximum res
  liftEffect $ log $ if ans == mempty then "-1" else (\s -> {- Int64 の接尾辞 l を消す -} S.take (S.length s - 1) s) (show (unwrap ans))

main :: Effect Unit
main = do
  input <- FS.readTextFile UTF8 "/dev/stdin"
  unsafePartial $ evalStateT main' input
toyboot4etoyboot4e

感想

Pros

部分関数に厳しい

制約の強い言語は基本好きです。 PureScript の部分関数を峻別する性質も良いと思います。競プロでは手間が増えますが、開発では良さそうでした。

型クラスの利用

Haskell の型クラスは遅延データ型としての実装が優先されることが多く、むしろ使わない方が良いものと思っています。 PureScript においては型クラスをゴリゴリに使って良さそうです。

少なくとも以下の型クラスを使っています:

ただ !! の型クラスが無いのは意外でした。検索が下手なだけかもですが。

Cons

Haskell との比較のためフェアではないですが、やはり AltJS らしく機能不足を感じます。

やや API が心もとない

もっと関数が多いと嬉しい気はします。今回、足りなかった関数は以下です:

  • String に span が無い
  • Array に findIndices が無い

部分適用がし辛い、タプルが書きにくい

Operator sections でこれは書けるみたいです。

half = (_ / 2)
double = (2 * _)

しかしこれは書けません。

Tuple _ rest <$> Int.fromString digits

下層が JS なのが辛そう

Int が 32 bit なのはかなり辛いと思いました。

興味・関心

  • Array, String の部分列はスライスかコピーか
  • 可変長配列はあるか
  • Data.Ord.Max が Semiring ではないのはなぜか
  • liftEffect . log $ 略 がコンパイルできないのはなぜか
  • (fromJust <$>) . readInt ではなく fromJust <$> readInt と書けるのはなぜか 納得しました
  • フュージョンはどうなっているか、イテレータはあるか

以上

総じて非常によくできた言語だと感じました。これを学び出したらどんどん深みへ連れられそうです。今後も極稀に触ってみたいです。

ゆきくらげゆきくらげ

アドカレありがとうございます！

複数のTuple は /\ ←　で書けます！
2 /\ "hoge" /\ true のように

パターンマッチも出来ます　型レベルにも同じオペレータが用意されてるので Int /\ String /\ Boolean になります

なので　
(_ /\ rest) <$> Int.fromString digits
こう書けると思います！

https://zenn.dev/zenn/articles/markdown-guide

toyboot4etoyboot4e

ゆきくらげさんありがとうございます！　/\ のおかげでちょっと良いコードになりました。とても嬉しいです。まだまだ改善の余地はあるかもしれませんが、今後機会があれば取り組んでみます。

readInt :: String -> Maybe (Tuple Int String)
readInt str =
  let str' = S.dropWhile C.isSpace str
      digits = S.takeWhile C.isDecDigit str'
      rest = S.drop (S.length digits) str'
      -- \ タプルの部分適用ができる !! /
   in (_ /\ rest) <$> Int.fromString digits
このスクラップは20日前にクローズされました