Study Haskell 2025

私は haskell のエキスパートで、ユーザーに haskell の使い方を教えながらコードを書きます。

ユーザーは TypeScript のエキスパートで、多少のRustの知識があります。Haskell は初心者です。

このプロジェクトは最新の cabal でセットアップされています。
stack を使わず、 cabal のみを使ってビルドと依存関係の管理を行います。

$ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh

export PATH=$PATH:$HOME/.ghcup/bin
[ -f "$HOME/.ghcup/env" ] && source "$HOME/.ghcup/env" 

$ ghcup tui
# or
$ ghcup install ghc 9.10.1
$ ghcup install cabal 3.14.2.0
$ ghcup install hls 2.9.0.1
$ ghcup set ghc 9.10.1

$ mkdir helloworld
$ cd helloworld
$ cabal init

# checkout cabal
$ curl -s -L https://stackage.org/lts/cabal.config -o cabal.project.freeze
# cabal.project.freeze のGHCバージョンを 9.10.1 に書き換える
$ cabal update
$ cabal freeze

{
  "haskell.manageHLS": "GHCup",
  "haskell.toolchain": {
    "ghc": "9.10.1",
    "hls": "2.9.0.1",
    "cabal": "3.14.2.0"
  }
}

$ tree app src test helloworld.cabal     
app
└── Main.hs
src
└── Lib.hs
test
└── Spec.hs
helloworld.cabal

cabal-version: 2.2
name: helloworld
version: 0.1.0.0
description: wip
author: mizchi
maintainer: miz404@gmail.com
copyright: 2025 Author name here
license: MIT
license-file: LICENSE
build-type: Simple
extra-source-files:
  CHANGELOG.md
  README.md

source-repository head
  type: git
  location: https://github.com/githubuser/helloworld

library
  exposed-modules:
    Lib

  other-modules:
    Paths_helloworld

  autogen-modules:
    Paths_helloworld

  hs-source-dirs:
    src

  ghc-options:
    -Wall
    -Wcompat
    -Widentities
    -Wincomplete-record-updates
    -Wincomplete-uni-patterns
    -Wmissing-export-lists
    -Wmissing-home-modules
    -Wpartial-fields
    -Wredundant-constraints

  build-depends:
    base >=4.20 && <5,
    cabal-gild,

  build-tool-depends: cabal-gild:cabal-gild >=1.6.0.0
  default-language: Haskell2010

executable helloworld-exe
  main-is: Main.hs
  hs-source-dirs:
    app

  ghc-options:
    -Wall
    -Wcompat
    -Widentities
    -Wincomplete-record-updates
    -Wincomplete-uni-patterns
    -Wmissing-export-lists
    -Wmissing-home-modules
    -Wpartial-fields
    -Wredundant-constraints
    -threaded
    -rtsopts
    -with-rtsopts=-N

  build-depends:
    base >=4.20 && <5,
    helloworld,

  default-language: Haskell2010

test-suite helloworld-test
  type: exitcode-stdio-1.0
  main-is: Spec.hs
  other-modules:
    Paths_helloworld

  autogen-modules:
    Paths_helloworld

  hs-source-dirs:
    test

  ghc-options:
    -Wall
    -Wcompat
    -Widentities
    -Wincomplete-record-updates
    -Wincomplete-uni-patterns
    -Wmissing-export-lists
    -Wmissing-home-modules
    -Wpartial-fields
    -Wredundant-constraints
    -threaded
    -rtsopts
    -with-rtsopts=-N

  build-depends:
    base >=4.20 && <5,
    helloworld,

  default-language: Haskell2010

name: Haskell CI

on:
  push:
    branches: ["main"]
  pull_request:
    branches: ["main"]

permissions:
  contents: read

jobs:
  build:
    runs-on: ubuntu-latest

    steps:
      - uses: actions/checkout@v3
      - uses: actions/setup-haskell@v1
        with:
          ghc-version: "9.10.1"
          cabal-version: "3.14.2.0"

      - name: Cache
        uses: actions/cache@v3
        env:
          cache-name: cache-cabal
        with:
          path: ~/.cabal
          key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}
          restore-keys: |
            ${{ runner.os }}-build-${{ env.cache-name }}-
            ${{ runner.os }}-build-
            ${{ runner.os }}-
      - name: Install dependencies
        run: |
          cabal update
          cabal build --only-dependencies --enable-tests --enable-benchmarks
      - name: Build
        run: cabal build --enable-tests --enable-benchmarks all
      - name: Run tests
        run: cabal test all

module Lib (add) where
add :: (Num a) => a -> a -> a
add x y = x + y

test-suite helloworld-test
  type: exitcode-stdio-1.0
  main-is: Spec.hs
  other-modules:
    Paths_helloworld

  autogen-modules:
    Paths_helloworld

  hs-source-dirs:
    test

  ghc-options:
    -Wall
    -Wcompat
    -Widentities
    -Wincomplete-record-updates
    -Wincomplete-uni-patterns
    -Wmissing-export-lists
    -Wmissing-home-modules
    -Wpartial-fields
    -Wredundant-constraints
    -threaded
    -rtsopts
    -with-rtsopts=-N

  build-depends:
    HUnit ^>=1.6,
    base >=4.20 && <5,
    helloworld,

  default-language: Haskell2010

import Lib
import Test.HUnit
import qualified System.Exit as Exit

test1 :: Test
test1 = TestCase (assertEqual "should return 3 (Int)" (3 :: Int) (add (1 :: Int) (2 :: Int)))

tests :: Test
tests = TestList [
    TestLabel "add test (Int)" test1,
    ]

main :: IO ()
main = do
    result <- runTestTT tests
    if failures result > 0 then Exit.exitFailure else Exit.exitSuccess

$ cabal test  
Configuration is affected by the following files:
- cabal.project.freeze
Build profile: -w ghc-9.10.1 -O1
In order, the following will be built (use -v for more details):
 - helloworld-0.1.0.0 (test:helloworld-test) (configuration changed)
Configuring test suite 'helloworld-test' for helloworld-0.1.0.0...
Preprocessing test suite 'helloworld-test' for helloworld-0.1.0.0...
Building test suite 'helloworld-test' for helloworld-0.1.0.0...
[3 of 3] Linking dist-newstyle/build/x86_64-linux/ghc-9.10.1/helloworld-0.1.0.0/t/helloworld-test/build/helloworld-test/helloworld-test [Library changed]
Running 1 test suites...
Test suite helloworld-test: RUNNING...
Cases: 6  Tried: 6  Errors: 0  Failures: 0
Test suite helloworld-test: PASS
Test suite logged to:
/home/mizchi/sandbox/helloworld/./dist-newstyle/build/x86_64-linux/ghc-9.10.1/helloworld-0.1.0.0/t/helloworld-test/test/helloworld-0.1.0.0-helloworld-test.log
1 of 1 test suites (1 of 1 test cases) passed.

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
    let smallerSorted = quicksort [a | a <- xs, a <= x]
        biggerSorted  = quicksort [a | a <- xs, a > x]
    in  smallerSorted ++ [x] ++ biggerSorted

import Lib
import Test.HUnit
import qualified System.Exit as Exit

test1 :: Test
test1 = TestCase (assertEqual "should return 3 (Int)" (3 :: Int) (add (1 :: Int) (2 :: Int)))

-- Double 型での add 関数のテスト
testAddDouble :: Test
testAddDouble = TestCase (assertEqual "should return 3.0 (Double)" (3.0 :: Double) (add (1.5 :: Double) (1.5 :: Double)))

-- クイックソートのテストケース
quickSortTestEmpty :: Test
quickSortTestEmpty = TestCase (assertEqual "for empty list" ([] :: [Int]) (quicksort []))

quickSortTestSorted :: Test
quickSortTestSorted = TestCase (assertEqual "for sorted list" ([1, 2, 3] :: [Int]) (quicksort ([1, 2, 3] :: [Int])))

quickSortTestReverse :: Test
quickSortTestReverse = TestCase (assertEqual "for reverse sorted list" ([1, 2, 3] :: [Int]) (quicksort ([3, 2, 1] :: [Int])))

quickSortTestRandom :: Test
quickSortTestRandom = TestCase (assertEqual "for random list" ([1, 1, 2, 3, 4, 5, 6, 9] :: [Int]) (quicksort ([3, 1, 4, 1, 5, 9, 2, 6] :: [Int])))

-- 全テストをまとめる
tests :: Test
tests = TestList [
    TestLabel "add test (Int)" test1,
    TestLabel "add test (Double)" testAddDouble,
    TestLabel "quicksort empty" quickSortTestEmpty,
    TestLabel "quicksort sorted" quickSortTestSorted,
    TestLabel "quicksort reverse" quickSortTestReverse,
    TestLabel "quicksort random" quickSortTestRandom
    ]

main :: IO ()
main = do
    result <- runTestTT tests
    if failures result > 0 then Exit.exitFailure else Exit.exitSuccess

  build-depends:
    base >=4.20 && <5,
    helloworld,
    req ^>= 3.13,
    aeson ^>= 2.2,
    text ^>= 2.1,
    bytestring ^>= 0.11,

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-} -- FromJSON と Show の自動導出に必要

module Main (main) where

import qualified Network.HTTP.Req as Req
import qualified Data.Aeson as Aeson
import Control.Monad.IO.Class (liftIO)
import GHC.Generics (Generic) -- DeriveGeneric に必要
import Data.Text (Text) -- Todo 型の title フィールドで使用

-- JSON 構造に対応するレコード型
data Todo = Todo
  { userId :: Int
  , id :: Text
  , title :: Text -- JSON の文字列は Text 型で扱うのが一般的
  , completed :: Bool
  } deriving (Generic, Show) -- Generic と Show を自動導出

-- FromJSON インスタンスを自動導出
-- これにより Aeson が JSON から Todo 型へ変換する方法を理解する
instance Aeson.FromJSON Todo

main :: IO ()
main = Req.runReq Req.defaultHttpConfig $ do
  -- レスポンスボディを Todo 型としてパースする
  response <- Req.req Req.GET
                  (Req.https "jsonplaceholder.typicode.com" Req./: "todos" Req./: "1")
                  Req.NoReqBody
                  Req.jsonResponse -- 型推論により Todo 型を期待する
                  mempty

  -- パースされた Todo 型のボディを取得
  let todo :: Todo = Req.responseBody response

  -- 結果 (Todo 型) をコンソールに出力 (Show インスタンスが使われる)
  liftIO $ print todo

$ cabal run
Todo {userId = 1, id = 1, title = "delectus aut autem", completed = False}

{
  "ormolu.path": "/home/mizchi/.cabal/bin/ormolu",
  "ormolu.args": [
    "--no-cabal"
  ],
  "[haskell]": {
    "editor.formatOnSave": true,
    "editor.defaultFormatter": "sjurmillidahl.ormolu-vscode"
  },
}

$ ormolu -i **/*.hs
## CI 用
$ ormolu -m check **/*.hs
src/Lib.hs
@@ -123,8 +123,8 @@
              let baseUrl = Req.https (T.pack host)
              let url = foldl (Req./:) baseUrl (map T.pack pathSegments)
              response <-
-               Req.req Req.GET url Req.NoReqBody Req.jsonResponse
-                 $ Req.port port
+               Req.req Req.GET url Req.NoReqBody Req.jsonResponse $
+                 Req.port port
              let todo = Req.responseBody response :: Todo
              return todo
            else do
@@ -133,7 +133,7 @@
              let baseUrl = Req.http (T.pack host)
              let url = foldl (Req./:) baseUrl (map T.pack pathSegments)
              response <-
-               Req.req Req.GET url Req.NoReqBody Req.jsonResponse
-                 $ Req.port port
+               Req.req Req.GET url Req.NoReqBody Req.jsonResponse $
+                 Req.port port
              let todo = Req.responseBody response :: Todo
              return todo
@@ -174,4 +174,4 @@
  quicksort (x : xs) =
    let smallerSorted = quicksort [a | a <- xs, a <= x]
        biggerSorted = quicksort [a | a <- xs, a > x]
-   in smallerSorted ++ [x] ++ biggerSorted
+    in smallerSorted ++ [x] ++ biggerSorted 

  "indentRainbow.ignoreErrorLanguages": ["haskell"]

$ cabal install hlint
$ hlint --default > .hlint.yaml

$ hlint src test
No hints

- ignore: {name: Use head}
- ignore: {name: Use guards}

all: build test run

run:
	@cabal run helloworld-exe -- https://jsonplaceholder.typicode.com/todos/1

build:
	@cabal build --enable-benchmarks all

format:
	@ormolu -i **/*.hs

check:
	@hlint src test
	@ormolu -m check **/*.hs

test: build
	@cabal test

module StateMonadExamples (runStateMonadExamples) where

import qualified Control.Monad.State as State

-- State モナドの例
runStateMonadExamples :: IO ()
runStateMonadExamples = do
  putStrLn "State モナドの例"
  putStrLn "================"

  -- 基本的な State モナドの例
  putStrLn "\n1. 基本的なカウンター例："
  let initialState :: Int = 0
  let (result1, finalState1) = State.runState simpleCounter initialState
  putStrLn $ "  結果: " ++ show result1
  putStrLn $ "  最終状態: " ++ show finalState1

  -- 複数の操作を組み合わせた例
  putStrLn "\n2. 複数の操作を組み合わせた例："
  let (result2, finalState2) = State.runState combinedOperations 0
  putStrLn $ "  結果: " ++ show result2
  putStrLn $ "  最終状態: " ++ show finalState2

  -- スタックマシンの例
  putStrLn "\n3. スタックマシンの例："
  let program = [Push 10, Push 5, Add, Push 3, Multiply]
  let (result3, finalStack) = State.runState (executeProgram program) []
  putStrLn $ "  プログラム: " ++ show program
  putStrLn $ "  結果: " ++ show result3
  putStrLn $ "  最終スタック: " ++ show finalStack

simpleCounter :: State.State Int Int
simpleCounter = do
  currentState <- State.get
  State.put (currentState + 1)
  return currentState

combinedOperations :: State.State Int [Int]
combinedOperations = do
  -- 状態を3回更新し、各ステップの状態を記録します
  val1 <- increment
  val2 <- increment
  val3 <- increment
  return [val1, val2, val3]
  where
    increment = do
      current <- State.get
      State.put (current + 1)
      return current

-- | スタックマシンの命令セット
data StackOp = Push Int | Add | Multiply
  deriving (Show)

-- | スタックマシンの実行
-- スタックは [Int] 型で表現します
executeProgram :: [StackOp] -> State.State [Int] (Maybe Int)
executeProgram [] = do
  stack <- State.get
  return $ case stack of
    (top : _) -> Just top
    [] -> Nothing
executeProgram (op : ops) = do
  executeOp op
  executeProgram ops
  where
    executeOp :: StackOp -> State.State [Int] ()
    executeOp (Push n) = do
      stack <- State.get
      State.put (n : stack)
    executeOp Add = do
      stack <- State.get
      case stack of
        (x : y : rest) -> State.put ((y + x) : rest)
        _ -> State.put stack -- スタックに十分な要素がない場合は何もしない
    executeOp Multiply = do
      stack <- State.get
      case stack of
        (x : y : rest) -> State.put ((y * x) : rest)
        _ -> State.put stack -- スタックに十分な要素がない場合は何もしない

module AsyncExamples (runAsyncExamples) where

import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.Async as Async
import Control.Exception (SomeException, catch)
import Data.Time.Clock (diffUTCTime, getCurrentTime)

basicAsyncExample :: IO ()
basicAsyncExample = do
  putStrLn "  非同期タスクを開始します..."
  asyncTask <- Async.async $ do
    putStrLn "  非同期タスクが実行中..."
    threadDelay (2 * 1000000) -- 2秒待機 (マイクロ秒単位)
    putStrLn "  非同期タスクが完了しました"
    return (42 :: Int) -- 結果を返す
  putStrLn "  メインスレッドは他の処理を続行できます"
  threadDelay (1 * 1000000) -- 1秒待機
  result <- Async.wait asyncTask
  putStrLn $ "  非同期タスクの結果: " ++ show result

import Control.Monad.Free (Free (Free, Pure), liftF)

-- 命令セット（コマンド）の定義
data StateCmd s next where
  Get :: (s -> next) -> StateCmd s next
  Put :: s -> next -> StateCmd s next
  Log :: String -> next -> StateCmd s next

-- Functor インスタンスの手動定義
instance Functor (StateCmd s) where
  fmap f (Get g) = Get (f . g)
  fmap f (Put s next) = Put s (f next)
  fmap f (Log msg next) = Log msg (f next)

-- Free モナドの型シノニム
type StateF s a = Free (StateCmd s) a

-- スマートコンストラクタ
get :: StateF s s
get = liftF $ Get id

put :: s -> StateF s ()
put s = liftF $ Put s ()

logMsg :: String -> StateF s ()
logMsg msg = liftF $ Log msg ()

-- StateF プログラムの例
incrementCounter :: StateF Int ()
incrementCounter = do
  current <- get
  logMsg $ "Current value: " ++ show current
  put (current + 1)

-- インタープリター (IO モナドで実行)
interpret :: StateF Int a -> Int -> IO (a, Int)
interpret (Pure a) s = return (a, s)
interpret (Free cmd) s = case cmd of
  Get f -> interpret (f s) s
  Put s' next -> interpret next s'
  Log msg next -> do
    putStrLn msg
    interpret next s

runExample :: IO ()
runExample = do
  (_, finalState) <- interpret program 0
  putStrLn $ "Final state: " ++ show finalState
  where
    program = do
      incrementCounter
      incrementCounter
      incrementCounter

-- | メイン関数
main :: IO ()
main = runExample

module Main (main) where

import Polysemy (Member, Sem, embedToFinal, runFinal)
import Polysemy.State (State, get, put, runState)
import Polysemy.Trace (Trace, trace, traceToStdout)

-- StateF プログラムの例
incrementCounter :: (Member (State Int) r, Member Trace r) => Sem r ()
incrementCounter = do
  current <- get @Int
  trace $ "Current value: " ++ show current
  put (current + 1)

-- プログラム全体
program :: (Member (State Int) r, Member Trace r) => Sem r Int
program = do
  incrementCounter
  incrementCounter
  incrementCounter
  get @Int -- 最終的な状態を返す

-- | メイン関数
main :: IO ()
main = do
  let state = runState @Int 0 program
  let traceProgram = traceToStdout state
  let ioProgram = embedToFinal @IO traceProgram
  (finalValue, _) <- runFinal ioProgram
  putStrLn $ "Final state: " ++ show finalValue