default.nix

let
  pkgs = import <nixpkgs> {};
  ghc = pkgs.haskellPackages.ghcWithPackages (p: with p; [ directory split transformers mtl linux-mount ] );
  hello_world = pkgs.stdenv.mkDerivation {
    name = "hello_world";
    buildInputs = with pkgs; [ ghc ];
    unpackPhase = "true";
    installPhase = ''
      mkdir -p $out/bin
      ghc ${./hello_world.hs} -static -split-sections -o $out/bin/init
    '';
  };
  hello_world' = pkgs.runCommand "hello_world2" {} ''cp ${hello_world}/bin/init $out'';
  tester = pkgs.writeScript "tester" ''
    #!${pkgs.stdenv.shell}
    export PATH=${pkgs.coreutils}/bin/:${pkgs.utillinux}/bin/
    mount -v -t proc proc proc
    ls -l /proc/self/fd/
    #${pkgs.strace}/bin/strace -f ${hello_world}/bin/init
  '';
  initrd  = pkgs.makeInitrd {
    contents = [
      {
        object = hello_world';
        symlink = "/init";
      }
    ];
  };
  kernel = pkgs.linuxPackages.kernel;
  script = pkgs.writeScriptBin "script" ''
  #!${pkgs.stdenv.shell}
  ${pkgs.qemu}/bin/qemu-system-x86_64 -kernel ${kernel}/bzImage -initrd ${initrd}/initrd -m 512 -append "console=ttyS0 quiet" -nographic -serial mon:stdio
  '';
in {
  inherit hello_world initrd kernel script tester;
}

hello_world.hs

{-# LANGUAGE LambdaCase #-}

module Main where
import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import System.Posix.Directory
import System.Directory
import Data.Char
import Data.List.Split
import Control.Monad.State
import System.Linux.Mount

data AppState = AppState { running :: Bool } deriving (Eq, Show, Read)

ls :: String -> IO ()
ls arg1 = mapM_ print =<< getDirectoryContents arg1

type Repl = StateT AppState IO

keepRunning :: Bool -> Repl ()
keepRunning b = modify $ \m -> m { running = b }

eval :: [String] -> Repl ()
eval ("ls" : arg1 : rest) = do
  liftIO $ ls arg1
eval ("ls" : rest) = do
  liftIO $ ls "."
eval ("quit":rest) = do
  keepRunning False
eval _  = do
  liftIO $ putStrLn "unknown command"

defaultMain :: Repl () -> IO ()
defaultMain repl = do
  mount "devtmpfs" "/dev" "devtmpfs" [] noData
  mount "proc" "/proc" "proc" [] noData
  mount "sysfs" "/sys" "sysfs" [] noData
  putStrLn "booted"
  flip evalStateT initialState repl
    where
      initialState = AppState True

main = defaultMain $ fix $ \loop ->
  running <$> get >>= \case
    False -> liftIO $ putStrLn "Exiting"
    True -> do
      liftIO $ putStr "> "
      line <- splitOn " " <$> liftIO getLine
      eval line >> loop