emmanueldenloye

{-# language OverloadedStrings #-}
import Data.Aeson (Value, decode)
import qualified Data.ByteString.Lazy.Char8 as BL
import Text.ParserCombinators.ReadP
import Control.Applicative hiding (many)
import Data.Char
import Data.Maybe (maybe)

data Expr = Json Value | StringLit String | Symbol String | Sexp [Expr] | Let [(String, Expr)] [Expr]
  deriving (Show)

emmanueldenloye

#!/usr/bin/env cabal
{- cabal:
build-depends: base
               , dependent-sum
               , mtl
-}

{-# language GADTs #-}
{-# language LambdaCase #-}

emmanueldenloye

  case _dbNotification_message notification of
    NotifyTag_Baker :=> Identity (bid, mBaker) -> handleBaker bid mBaker
    NotifyTag_BakerDetails :=> Identity bakerDetails -> handleBakerDetails bakerDetails
    NotifyTag_BakerRightsProgress :=> Identity (_x, y, _z) -> handleBakerAddress (_bakerRightsCycleProgress_publicKeyHash y)
    NotifyTag_ErrorLog tag :=> Identity eid ->
      logAssume tag $ handleErrorLog (errorLogIdForErrorLogView . (tag :=>) . Identity) tag eid
    NotifyTag_ProtocolIndex :=> Identity eid -> handleParameters eid
    NotifyTag_MailServerConfig :=> Identity (_eid, cfg) -> handleMailServer cfg
    NotifyTag_NodeExternal :=> Identity (eid, ent) -> (<>) <$> handleNodeExternal eid ent <*> alsoEveryBakerSummary
    NotifyTag_NodeInternal :=> Identity (eid, ent) -> (<>) <$> handleNodeInternal eid ent <*> alsoEveryBakerSummary

emmanueldenloye

(defun haskell-quick-nix-build ()
  (interactive)
  (when-let ((original-directory (file-name-directory (buffer-file-name))))
    (let ((current-directory original-directory))
      (while (and
              (not
               (or
                (string= current-directory (expand-file-name "~"))
                (string= current-directory (expand-file-name "/"))))
              (not (directory-files current-directory nil "cabal$")))

emmanueldenloye

(defun unsafe-reload-init-file
    ()
  "Reload init.el file"
  (interactive)
  (let
      ((debug-on-error t))
    (load user-init-file)
    (message "Reloaded init.el OK.")))

emmanueldenloye

guardTable :: Show n => FunApp -> Term n -> Eval e ()
guardTable i TTable {..} = do
  r <- uses evalCallStack (alaf Last foldMap (firstOf (sfApp . _Just . _1 . faModule . _Just)))
  case r of
    (Just mn) | mn == _tModule -> enforceBlessedHashes i _tModule _tHash
    _ -> do
      m <- getModule (_faInfo i) _tModule
      enforceKeySetName (_faInfo i) (_mKeySet m)
guardTable i t = evalError' i $ "Internal error: guardTable called with non-table term: " ++ show t

emmanueldenloye

(setq haskell-process-use-presentation-mode t)

emmanueldenloye

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}

import Data.Monoid

data Same a
  = Same a
  | NotSame
  | EmptySame
  deriving (Eq, Show)

emmanueldenloye

-- Got inspiration from http://izzycecil.com/posts/2015-07-29-circular.html

trace :: (a -> c -> (b, c)) -> a -> b
trace f a = b
  where (b, c) = f a c

collect' :: (Ord a)  => (a -> a -> a) -> [a] -> a -> ([a],a)
collect' f [x] m = ([m],x)
collect' f (x:xs) m =
  let (replaced, m') = collect' f xs m

emmanueldenloye

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}

module CartesianTree where

import Control.Lens