public
Last active

.ghci

  • Download Gist
.ghci
1
:set -isrc -itest -Wall -optP-include -optPdist/build/autogen/cabal_macros.h
Binary.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
{-# 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
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
{-# 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
IoState.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
{-# 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"
MultiParamTypeClasses.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
{-# 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
Literate Haskell

!/usr/bin/env runhaskell

module Main where
import Distribution.Simple
main :: IO ()
main = defaultMain
State.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
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
applicative.hs
Haskell
1 2 3 4 5 6 7 8 9 10
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"
ghc.sh
Shell
1 2
sudo apt-get install libgmp-dev libgmp3-dev libgmp3c2
./configure --prefix=/home/gert/.ghc
main.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
{-# 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
Haskell
1 2 3 4 5
fmap ab ma = ma >>= (return . ab)
(return . ab) = \x -> return (ab x)
 
x >>= (\v -> return (f v))
fmap f x
xmonad.hs
Haskell
1 2 3 4 5 6 7 8 9
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}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.