{-# LANGUAGE OverloadedStrings #-}

import Snap.Core
import Snap.Http.Server

hello :: Snap ()
hello = writeText "Hello, Snap!"

app :: Snap ()
app = route [("/", hello)]

main :: IO()
main = quickHttpServe app

import Options.Applicative

data Sample = Sample
  { hello :: String
  , quiet :: Bool }

sample :: Parser Sample
sample = Sample
  <$> strOption
      ( long "hello"
      <> metavar "TARGET"
      <> help "Target for the greeting" )
  <*> switch
      ( long "quiet"
      <> help "Whether to be quiet" )

greet :: Sample -> IO ()
greet (Sample h False) = putStrLn $ "Hello, " ++ h
greet _ = return ()

main :: IO ()
main = execParser opts >>= greet
  where
    opts = info (helper <*> sample)
      ( fullDesc
      <> progDesc "Print a greeting for TARGET"
      <> header "hello - a test for optparse-applicative" )

$ ./optest 
Usage: optest --hello TARGET [--quiet]

$ ./optest --hello Haskell
Hello, Haskell

$ ./optest --help
hello - a test for optparse-applicative

Usage: optest --hello TARGET [--quiet]
  Print a greeting for TARGET

Available options:
  -h,--help                Show this help text
  --hello TARGET           Target for the greeting
  --quiet                  Whether to be quiet

mkvirthualenv yesod

$ workhon yesod
Activating yesod Virtual Haskell Environment (at /Users/kzfm/.virthualenv/yesod).

Use regular Haskell tools (ghc, ghci, ghc-pkg, cabal) to manage your Haskell environment.

To exit from this virtual environment, enter command 'deactivate'.
(yesod)localhost@kzfm:~ $

cabal install yesod-platform-1.1.5
cabal install persistent-sqlite-1.0.1

$ lsvirthualenv 
diagrams
hakyll
per2
persistent
scotty
snap
yesod

$ rmvithualenv snap
$ lsvirthualenv 
diagrams
hakyll
per2
persistent
scotty
yesod

newtype ActionM a = AM { runAM :: ErrorT ActionError (ReaderT ActionEnv (StateT Response IO)) a }
    deriving ( Monad, MonadIO, Functor
             , MonadReader ActionEnv, MonadState Response, MonadError ActionError)

defaultHandler :: ActionError -> ActionM ()
defaultHandler (Redirect url) = do
    status status302
    header "Location" url
defaultHandler (ActionError msg) = do
    status status500
    html $ mconcat ["<h1>500 Internal Server Error</h1>", msg]
defaultHandler Next = next

{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Data.Monoid

main :: IO ()
main = scotty 3000 $ do
    get "/" $ text "Helllo Scotty"

    get "/lang" $ do
        v <- param "type"
        html $ mconcat ["<h1>", v, "</h1>"]

{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
{-# LANGUAGE GADTs, FlexibleContexts #-}
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.IO.Class (liftIO)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name String
    age Int Maybe
    loc String default="Japan"
    deriving Show
|]

main :: IO ()
main = withSqliteConn "test.db" $ runSqlConn $ do
    runMigration migrateAll
    johnId <- insert $ Person "kzfm" (Just 20) "Fuji"
    liftIO $ print johnId

CREATE TABLE "Person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name String
    age Int Maybe
    loc String default="Japan"
    deriving Show
|]

main :: IO ()
main = withSqliteConn "test.db" $ runSqlConn $ do
    runMigration migrateAll
    johnId <- insert $ Person "kzfm" (Just 20) "Fuji"
    liftIO $ print johnId

CREATE TEMP TABLE "Person_backup"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL,"loc" VARCHAR NOT NULL DEFAULT "Japan")
INSERT INTO "Person_backup"("id","name","age") SELECT "id","name","age" FROM "Person"
DROP TABLE "Person"
CREATE TABLE "Person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL,"loc" VARCHAR NOT NULL DEFAULT "Japan")
INSERT INTO "Person" SELECT "id","name","age","loc" FROM "Person_backup"
DROP TABLE "Person_backup"

sqlite> select * from person;
1|kzfm|20|Japan
2|kzfm|20|Fuji

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name String
    age Int Maybe
    loc String Maybe
    deriving Show
|]

No instance for (Control.Monad.Trans.Resource.MonadResource IO)
  arising from a use of `selectList'
Possible fix:
  add an instance declaration for
  (Control.Monad.Trans.Resource.MonadResource IO)
In a stmt of a 'do' block:
  oneJohnPost <- selectList [BlogPostAuthorId ==. johnId] [LimitTo 1]
In the second argument of `($)', namely
  `do { runMigration migrateAll;
        johnId <- insert $ Person "John Doe" $ Just 35;
        janeId <- insert $ Person "Jane Doe" Nothing;
        insert $ BlogPost "My fr1st p0st" johnId;
        .... }'
In the second argument of `($)', namely
  `runSqlConn
   $ do { runMigration migrateAll;
          johnId <- insert $ Person "John Doe" $ Just 35;
          janeId <- insert $ Person "Jane Doe" Nothing;
          insert $ BlogPost "My fr1st p0st" johnId;
          .... }'

{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
{-# LANGUAGE GADTs, FlexibleContexts #-}
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.IO.Class (liftIO)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name String
    age Int Maybe
    deriving Show
|]

main :: IO ()
main = withSqliteConn "test.db" $ runSqlConn $ do
    runMigration migrateAll
    -- johnId <- insert $ Person "John Doe" $ Just 35
    -- liftIO $ print johnId

{-# LANGUAGE NoMonomorphismRestriction #-}
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine
import Data.Colour

tri c n = dots <> (strokeT edges # lc c # lw 0.2 # fcA (c `withOpacity` 0.5))
  where rows = map (hcat' with { sep = 1 })
             . zipWith replicate [n,n-1..1]
             . repeat
             $ dot c
        dots = decorateTrail (rotateBy (1/6) edge) rows
        edge = fromOffsets . replicate (n-1) $ unitX # scale 3
        edges = close (edge <> rotateBy (1/3) edge <> rotateBy (2/3) edge)

dot c = unitCircle # lw 0 # fc c

rowSpc = height (rotateBy (1/6) $ strutY 1 :: D R2)
row k n s c = hcat' with {sep = 1 + 3*s} (replicate k (tri c n))
law4 k n c1 c2 = vcat' with {sep = rowSpc} (map tRow [1..k])
  where tRow k = (row k n 0 c1 # centerX # alignT)
                 <>
                 (row (k-1) (n-1) 1 c2 # reflectY # centerX # alignT)
exampleRow f = hcat' with {sep = 4} . map (alignB . f)

law4Dia = exampleRow law4' [2..4]
  where law4' k = law4 k 3 purple gold

example = pad 1.1 $ law4Dia # centerXY

main = defaultMain example