.ghci

.ghci

:set -isrc -itest -Wall -optP-include -optPdist/build/autogen/cabal_macros.h

applicative.hs

http://www.yesodweb.com/book/persistent
 
    fromPersistValues [nameValue, ageValue] = let nameValue' = fromPersistValue nameValue
                                                  ageValue' = fromPersistValue ageValue
                                               in case nameValue' of
                                                    Left e -> Left e
                                                    Right name -> case ageValue' of
                                                                    Left e -> e
                                                                    Right age -> Right (Person name age)
    fromPersistValues _ = Left "Invalid fromPersistValues input"

Binary.hs

{-# LANGUAGE RecordWildCards, TypeFamilies#-}
import Control.Applicative
import Data.SafeCopy
import Data.Binary
import Data.Serialize.Get
import Data.Serialize.Put
 
type Name = String
type Address = String
type Phone = String
 
data Contact = Contact { name :: Name, address :: Address, phone :: Phone } deriving (Show)
instance Binary Contact where
    put Contact{..} = do put name; put address; put phone
    get = do name <- get; address <- get; phone <- get; return Contact{..}
instance SafeCopy Contact where
    putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
    getCopy = contain $ Contact <$> safeGet <*> safeGet <*> safeGet
 
data Contacts = Contacts [Contact] deriving (Show)
instance Binary Contacts where
    put (Contacts set) = put set
    get = fmap Contacts get
instance SafeCopy Contacts where
     version = 2
     kind = extension
     putCopy (Contacts contacts) = contain $ safePut contacts
     getCopy = contain $ Contacts <$> safeGet
instance Migrate Contacts where
     type MigrateFrom Contacts = Contacts_v0
     migrate (Contacts_v0 contacts) = Contacts[Contact{name=name,address=address,phone=""}|(name,address)<-contacts]
 
data Contacts_v0 = Contacts_v0 [(Name, Address)] deriving (Show)
instance Binary Contacts_v0 where
    put (Contacts_v0 set) = put set
    get = fmap Contacts_v0 get
instance SafeCopy Contacts_v0 where
    putCopy (Contacts_v0 list) = contain $ safePut list
    getCopy = contain $ Contacts_v0 <$> safeGet
 
main :: IO ()
main = do
    -- 
    -- instance Binary 
    --
    let c' = Contacts[Contact{name="gert",address="home",phone="test"},Contact{name="gert2",address="home2",phone="test2"}]
    let e' = encode c'
    print e'
    let d' = decode e'
    print (d':: Contacts)
 
    let c = Contacts_v0 [("gert_v0","home_v0"),("gert2_v0","home2_v0")]
    let e = encode c
    print e
    let d = decode e
    print (d:: Contacts_v0)
    --can not do print (d:: Contacts) meaning you are screwed
 
    --
    -- instance SafeCopy
    --
    let c'' = Contacts_v0 [("gert_v0","home_v0"),("gert2_v0","home2_v0")]
    let e'' = runPut (safePut c'')
    print e''
    let d'' = runGet safeGet e''
    case d'' of
        Left _ -> print "error"
        Right d'' -> print (d'':: Contacts)
    --can do print (d:: Contacts) or print (d:: Contacts_v0) meaning you are safed

Db.hs

{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
module Db (
    couchTest
) where
 
--import Control.Monad.IO.Class (MonadIO, liftIO)
--import Control.Monad.Trans.Resource (MonadThrow, MonadUnsafeIO)
--import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import Data.Generics (Data, Typeable)
import Database.CouchDB.Conduit
import Database.CouchDB.Conduit.Generic
 
conn :: CouchConnection
conn = def {couchLogin = "admin", couchPass = "admin"}
 
data D = D { f1 :: Int, f2 :: String } deriving (Show, Data, Typeable)
 
--couchTest :: (MonadIO m, MonadUnsafeIO m, MonadThrow m, MonadBaseControl IO m) => m ()
couchTest:: IO ()
couchTest = runCouch conn $ do
    rev1 <- couchPut "mydb" "my-doc1" "" [] $ D 123 "str"
    rev2 <- couchPut "mydb" "my-doc1" rev1 [] $ D 1234 "another"
    (rev3, d1 :: D) <- couchGet "mydb" "my-doc1" []
    liftIO $ print d1
    couchPut' "mydb" "my-doc1" [] $ D 12345 "third"    -- notice - no rev
    rev3 <- couchRev "mydb" "my-doc1"
    couchDelete "mydb" "my-doc1" rev3

ghc.sh

sudo apt-get install libgmp-dev libgmp3-dev libgmp3c2
./configure --prefix=/home/gert/.ghc

IoState.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExtendedDefaultRules #-}
 
module IoState where
 
import Control.Monad.State.Class
 
import Data.IORef
import System.IO.Unsafe
 
type IoState s = IO
 
stRef :: IORef a
stRef = unsafePerformIO (newIORef undefined)
{-# NOINLINE stRef #-}
 
instance MonadState s (IoState s) where
     get = readIORef stRef
     put st = writeIORef stRef st
 
runIoState :: s -> IoState s a -> IO a
runIoState st action = do
    writeIORef stRef st
    action
 
test1 :: IO ()
test1 = runIoState (2 :: Int) (get >>= print)
-- prints "()"
 
test2 :: IO ()
test2 = runIoState (2 :: Int) (get >>= print . (+ (1::Int)))
-- prints "3"
 
test3 :: IO ()
test3 = runIoState (2 :: Int) (get >>= print . (+ (1 :: Double)))
-- prints "1.0"

main.hs

{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell, OverloadedStrings, GADTs #-}
module Main where
import Control.Monad.IO.Class (liftIO)
import Data.String (fromString)
import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Network.Wai.Application.Static (staticApp, defaultWebAppSettings, defaultFileServerSettings)
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsIntercept, settingsPort)
import Network.Wai.Handler.WebSockets (intercept)
import qualified Network.WebSockets as WS

mkPersist sqlSettings [persist|
Person
    name String
    age Int
    deriving Show
|]

ws :: WS.Request -> WS.WebSockets WS.Hybi10 ()
ws r = WS.acceptRequest r >> do
    michaelId <- insert $ Person "Michael" 26
    michael <- get michaelId
    liftIO $ print michael

main :: IO ()
main = runSettings defaultSettings
    { settingsPort = 9160
    , settingsIntercept = intercept ws
    } $ staticApp (defaultFileServerSettings $ fromString ".")

monad.hs

fmap ab ma  =  ma >>= (return . ab)
(return . ab)  =  \x -> return (ab x)

x >>= (\v -> return (f v))
fmap f x

MultiParamTypeClasses.hs

{-# LANGUAGE MultiParamTypeClasses #-}
import Data.Char
 
class Convertable a b where
    convert :: a -> b
 
instance Convertable Int Bool where
    convert 0 = False
    convert _ = True
 
instance Convertable Int Char where
    convert = chr
 
main :: IO ()
main = do
    print (convert x :: Bool)
    print (convert x :: Char)
  where x :: Int
        x = 49
 
 
class MonadState s where
    put :: Monad m => s -> m ()
    get :: Monad m => m s
 
instance MonadState Int where
    -- No way to ensure put and get are using the same monad m!

Setup.lhs

#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain

State.hs

module Count where
import Control.Monad.State
 
count :: Int -> Int
count c = c+1
 
count' :: State Int Int
count' = do
    c <- get
    put (c+1)
    return (c+1)
 
main :: IO ()
main = do
    print $ count $ count $ count $ count $ count $ count 0
    print $ evalState count' $ evalState count' $ evalState count' $ evalState count' 0

xmonad.hs

import XMonad
import XMonad.Hooks.InsertPosition
--import XMonad.Layout.Reflect
--hook = reflectHoriz $ Mirror $ Tall 1 (3/100) (1/2)
hook = (Tall 1 (3/100) (1/2)) ||| Full
main = xmonad defaultConfig {borderWidth=0, 
                             modMask=mod4Mask,
                             manageHook=insertPosition Below Older,
                             layoutHook=hook}