Notebook

  nixpkgs.config.allowUnfree = true;

  i18n = {
    consoleFont = "Lat2-Terminus16";
    consoleKeyMap = "be-latin1";
    defaultLocale = "en_US.UTF-8";
  } ;

  environment.systemPackages = with pkgs; [
    asciidoctor (1)
  ];

  # Define a user account. Don't forget to set a password with ‘passwd’.
  users.extraUsers.nix = { (2)
    createHome = true;
    home = "/home/nix";
    isSystemUser = true;
    extraGroups = [ "wheel" "disk" "vboxusers" "docker"];
    shell = "/run/current-system/sw/bin/bash";
    uid = 1000;
  };

  programs.bash.enableCompletion = true;
  security.sudo.wheelNeedsPassword = false;

  fonts = {
    enableFontDir = true;
    fonts = [ pkgs.source-code-pro ];
  };

  nix.extraOptions = ''
    gc-keep-outputs = true (3)
    gc-keep-derivations = true (3)
  '';

  virtualisation.docker.enable = true;
  virtualisation.docker.extraOptions = "--insecure-registry x.lan --insecure-registry y.lan";

  virtualisation.virtualbox.guest.enable = true; (4)
  boot.initrd.checkJournalingFS = false; (4)

→ sudo nixos-rebuild switch
→ sudo nixos-rebuild boot --upgrade (1)

class Num a where
  (+) :: a -> a -> a
  (*) :: a -> a -> a
  (-) :: a -> a -> a
  negate :: a -> a
  abs :: a -> a
  signum :: a -> a
  fromInteger :: Integer -> a

→ enumFromTo 3 8     -> [3,4,5,6,7,8]
→ enumFromTo 'a' 'f' -> "abcdef"

data Nat = Zero | Succ Nat

-- Add is a type which is a function on types
type family Add (x :: Nat) (y :: Nat) :: Nat
-- Then comes the implementation of the (type) function
type instance Add Zero     y = y
type instance Add (Succ x) y = Succ (Add x y)

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Typeable

data Animal = Cat | Dog deriving Typeable
data Zoo a = Zoo [a] deriving Typeable

example :: TypeRep (1)
example = typeRep (Zoo [Cat, Dog]) (2)
-- Zoo Animal

class Typeable a where
  typeRep :: Proxy a -> TypeRep (1)

class Functor f where
	fmap :: (a -> b) -> f a -> f b

instance Functor ((->) r) where
  fmap f g = f . g -- or fmap = (.)

class Contravariant f where
  contramap :: (b -> a) -> f a -> f b

class Functor f => Applicative f where
  pure :: a -> f a
 (<*>) :: f (a -> b) -> f a -> f b

liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2 f a b = fmap f a <*> b

class Applicative m => Monad m where
  join :: m (m a) -> m a

(>>=) :: m a -> (a -> m b) -> m b (1)

data Free f a = Pure a | Free (f (Free f a))

loop = tail loop

fst (1, loop)
-- innermost reduction gives:
-- fst (1, (tail loop))
-- fst (1, (tail (tail loop))) and never terminates
-- but outermost reduction gives:
-- fst (1, loop) = 1 and terminates

instance Monoid r => Monoid (Managed r) where
    mempty = pure mempty
    mappend = liftA2 mappend

xs = 1 : [x + 1 | x <- xs] --> [1,2,3 ...]

Right cfg -> return . Right . query cfg fp =<< F.newFileCache

# ! inefficient !
→ [1..10000] ++ [4]

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f v [] = v
foldr f v (x:xs) = f x (foldr f v xs)

foldl :: (s -> a -> s) -> s -> [a] -> s
foldl  f v []     =  v
foldl  f v (x:xs) =  foldl f (f v x) xs

{-# LANGUAGE ExistentialQuantification #-}
-- existential datatype (note that `x` does not appear on the left side)
data Fold a b
--                    step func      initial acc     extract func (done)
 = forall x . Fold  (x -> a -> x)       x             (x -> b)

-- expressed as a GADT it would be:
data Fold a b where
  Fold :: (r -> b) -> (r -> a -> r) -> r -> Fold a b

-- | Apply a strict left 'Fold' to a 'Foldable' container
fold :: Foldable f => Fold a b -> f a -> b
fold (Fold step begin done) as = F.foldr cons done as begin
  where
    cons a k x = k $! step x a

average = (/) <$> sum <*> genericLength

sum :: Num a => Fold a a
sum = Fold (+) 0 id

genericLength :: Num b => Fold a b
genericLength = Fold (\n _ -> n + 1) 0 id

λ> fold average [1..10000000]

class Foldable t where
  fold    :: Monoid m => t m -> m
  foldMap :: Monoid m => (a -> m) -> t a -> m
  foldMap g = mconcat . map g

λ> foldMap Sum [1,2,3,4]
Sum {getSum = 10}

mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
mapM_ f = foldr ((>>) . f) (return ())

class (Functor t, Foldable t) => Traversable t where
  traverse  :: Applicative f => (a -> f b) -> t a -> f (t b)
  traverse f = sequenceA . fmap f
  mapM = traverse
  sequenceA :: Applicative f => t (f a) -> f (t a)
  sequenceA = traverse id

for = flip traverse

{-# LANGUAGE TemplateHaskell #-}

data Person = Person
  { _firstname :: String
  , _surname   :: String
  }
-- building lenses for _firstname and _surname
makeLenses ''Person
-- create an HasPerson class with the `firstname` and `surname` optics
makeClassy ''Person
-- create an HasFirstname and HasSurname class
data Person = Person
  { _PersonFirstname :: String
  , _PersonSurname   :: String
  }
makeField ''Person

view :: Lens' s a -> s -> a
set :: Lens' s a -> a -> s -> s
over :: Lens' s a -> (a -> a) -> s -> s

type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s (1)

type Traversal' a b =
    forall f . (Applicative f) => (b -> f b) -> (a -> f a)

firstOf/lastOf traverse :: Traversable t => t a -> Maybe a

> firstOf traverse [1,2,3]
1
> [1..8] & lastOf traverse
8

> s = (Left 5, 5)
> s ^? _1._Left
Just 5
> s ^? _1._Right
Nothing
> :t preview _Right (Right 1)
Num b => Maybe b

-- create the nested Map when it is missing:
Map.empty & at "hello" . non Map.empty . at "world" ?~ "!!!"
-- > fromList [("hello",fromList [("world","!!!")])]

newtype State s a = State { runState :: s -> (a, s) }

-- an ST action returning a value of type a in state t
newtype ST s a = ST (Store s -> (a, Store s))
 -- a mutable variable in thread s
data STRef s a = STRef (MutVar# s a)

newSTRef :: a -> ST s (STRef s a)
readSTRef :: STRef s a -> ST s a
writeSTRef :: STRef s a -> a -> ST s ()

throwIO :: Exception e => e -> IO a

try :: Exception e => IO a -> IO (Either e a)

catch  :: Exception e
        => IO a        -- ^ computation
        -> (e -> IO a) -- ^ handler
        -> IO a

finally
        :: IO a -- ^ computation
        -> IO b -- ^ computation to run afterward even if an exception was raised
        -> IO a
a `finally` sequel =
  mask $ \restore -> do
    r <- restore a `onException` sequel
    _ <- sequel
    return r

-- | Like 'finally', but only performs the final action if there was an
-- exception raised by the computation.
onException :: IO a -> IO b -> IO a
onException io what =
  io `catch` \e -> do _ <- what
                        throwIO (e :: SomeException)

bracket
        :: IO a        -- ^ acquire resource
        -> (a -> IO b) -- ^ release resource
        -> (a -> IO c) -- ^ use resource
        -> IO c
bracket before after use =
  mask $ \restore -> do
    a <- before
    r <- restore (use a) `onException` after a
    _ <- after a
    return r

buildDir = "_build"

main = shakeArgs shakeOptions{shakeFiles=buildDir </> "_shake"} $ do

  daemon <- liftIO $ initDaemon pref (1)

  "test" ~> do (2)
    content <- readFile' (buildDir <> "/build.last") (3)
    putNormal content
    let hasFailure = any (\i -> "x" `isPrefixOf` i) (lines content)
    if hasFailure
      then fail "The build has failed !"
      else liftIO $ putDoc (dullgreen "All green." <> line)

  buildDir <> "/build.last" %> \out -> do
    Right nx <- liftIO $ runExceptT $ getNodes pdbapi QEmpty
    let deps = [ buildDir <> "/" <> Text.unpack n <> ".node" | n <- nx ^.. traverse.nodeInfoName]
    need deps
    Stdout stdout <- quietly $ cmd ("cat"::String) deps
    writeFileChanged out stdout

  buildDir <> "//*.node" %> \out -> do
    let node = dropDirectory1 (dropExtension out)
    facts <- liftIO $ mergeFacts (pref ^. prefFactsDefault) (pref ^. prefFactsOverride) <$> F.puppetDBFacts (Text.pack node) pdbapi
    r <- liftIO $ getCatalog daemon (Text.pack node) facts
    deps <- liftIO $ Set.fromList .HM.keys <$> getStats (parserStats daemon)
    need $ Text.unpack <$> Set.toList deps
    case r of
      S.Right _ ->
        liftIO $ withFile out WriteMode (\h -> hPutDoc h ( dullgreen "✓" <+> text node <> line))
      S.Left msg ->
        liftIO $ withFile out WriteMode (\h -> hPutDoc h ( char 'x' <> space <> red (text node) <> line <> indent 2 (getError msg) <> line))

newtype Shell a = Shell { _foldIO :: forall r . FoldM IO a r -> IO r }

shell
    :: Text        -- Command line
    -> Shell Line  -- Lines of standard input to feed to program
    -> io ExitCode

shells :: Text-> Shell Line -> io ()

select ::        [a] -> Shell a
liftIO ::      IO a  -> Shell a
using  :: Managed a  -> Shell a

-- usual construction primitive
empty :: Shell a

-- consume the stream by printing it to stdout
view   :: Show a => Shell a -> IO ()
stdout :: Shell Text -> IO ()

-- consume the (side-effect) stream, discarding any unused values
sh :: MonadIO io => Shell a -> io ()

inshell :: Text -> Shell Line -> Shell Line

inproc "curl" ["-s"
              , "http://"
              ] empty (1)
    & output "filename.ext" (2)

let path = "foo" </> fromText eclipseVersion </> "plugin"
    _path = format fp path

data Command
  = Console
  | Stack (Maybe StackName, StackCommand)
  deriving (Show)

commandParser :: Parser Command
commandParser =
      Console <$  subcommand "console" "Help msg" (pure ())
  <|> Stack   <$> subcommand "stack" "Help msg" stackParser (1)

runStateP
    :: (Monad m)
    => s -- state (usually of type proxy)
    -> Proxy a' a b' b (S.StateT s m) r
    -> Proxy a' a b' b m (r, s)

-- !! this return a Producer a m (Maybe r, Producer a m r) !!
-- This makes sense you are actually running the StateT monad from Producer a (StateT (Producer a m r) m r) r
-- r is either Just which means the original Producer is empty or Nothing which mean you should go on drawing from the original Producer
-- The top producer accumulates your split, then you have a pair of a Maybe r and your original Producer

runStateP p $ do -- p will be used to feed the underlying proxy
    -- entering a monad of the form: (Proxy (<- StateT monad <- Proxy))
    -- All computation happens inside the underlying monad that is initially fed up by the param p
    x <- lift draw -- lift the next value of the underlying proxy
    case x of -- Left if the underlying proxy is empty or Right with the drawn element
        Left  r -> return (Just r)
        Right a -> do
            yield a -- push `a onto the top proxy
            (Just <$> input) >-> (Nothing <$ takeWhile (== a))  -- start streaming values from the underlying proxy
                                                                --

(output, input) <- spawn Unbounded

newtype Input a = Input { recv :: S.STM (Maybe a) }

type Parser a m r = forall x . StateT (Producer a m x) m r

draw :: (Monad m) => Parser a m (Maybe a)

runStateT  :: Parser a m r -> Producer a m x -> m (r, Producer a m x)
evalStateT :: Parser a m r -> Producer a m x -> m  r
execStateT :: Parser a m r -> Producer a m x -> m (   Producer a m x)

splitAt
    :: Monad m
    => Int
    -> Lens' (Producer a m x) (Producer a m (Producer a m x))

zoom
    :: Lens' (Producer a m x) (Producer b m y)
    -> Parser b m r
    -> Parser a m r

-- A "splitter" such as `groupBy`, `chunksOf` or `splitOn`
Producer a m ()           -> FreeT (Producer a m) m ()  ~   [a]  -> [[a]]

-- A "transformation" such as `takeFree`
FreeT (Producer a m) m () -> FreeT (Producer a m) m ()  ~  [[a]] -> [[a]]

-- A "joiner" such as `concat` or `intercalate`
FreeT (Producer a m) m () -> Producer a m ()            ~  [[a]] ->  [a]

producer :: Buffer a -> Producer a IO () -> Managed (Controller a)

asPipe :: Pipe a b (State s) () -> Model s a b

asSink :: (a -> IO ()) -> View aa

runMVC ::
  initialState
  -> Model s a b
  -> Managed (View b, Controller a)
  -> IO s

type Producer b =                    Proxy Void () () b
type Producer' b m r = forall x' x . Proxy x' x () b m r

data List a
  = Cons a (List a)
  | Nil

data MySum = A | B
data MyProduct = MyProduct Int String

data Person = Person
  { _firstName :: String -- ^ First name
  , _lastName  :: String -- ^ Last name
  } deriving (Eq, Show)

data Person
  = Person
  { _firstName :: String
  , _lastName  :: String
  } deriving (Eq, Show)

module Puppet.Parser (
         expression
       , puppetParser
       , runPParser
       ) where

  readline >>= \case
    Just "Y" -> pure ()
    _        -> die "Abort"

-- | Unwrap a maybe value in an io computation
-- passing an alert action in case of Nothing
unwrapWith :: MonadIO io => io a -> Maybe a -> io a (1)
unwrapWith io_alert v = maybe io_alert pure v
<1> Note how `a` fixes the input/output

 readline >>= \case
   Nothing -> die "Abort"
   Just v  -> pure v

  readline >>= maybe (die "Abort") pure (1)

salt '*.be.brussels' test.ping
salt -L 'web1,web2,web3' disk.usage
salt -E 'web[0-9]' cmd.exec_code python 'import sys; print sys.version'

base:
'web-(develjstaging)'
  - match: pcre
  - webserver

base: (1)
  'bmob': (2)
    - packages (3)

file_roots:
  base:
    - /srv/salt