diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for typed-admin
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# typed-admin
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/DataSource2.hs b/app/DataSource2.hs
new file mode 100644
--- /dev/null
+++ b/app/DataSource2.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module DataSource2 where
+
+import           Control.Monad.IO.Class
+import           Database.HDBC                   (commit, disconnect)
+import           Database.HDBC.PostgreSQL        (Connection, connectPostgreSQL)
+import           Database.HDBC.Query.TH          (defineTableFromDB)
+import           Database.HDBC.Record
+import           Database.HDBC.Schema.Driver     (typeMap)
+import           Database.HDBC.Schema.PostgreSQL (driverPostgreSQL)
+import           Language.Haskell.TH             (Dec, Name, Q, TypeQ)
+
+-- createPool' config = createPool (connect config) disconnect (dbPoolStripeNum config) (realToFrac (dbPoolKeepTime config)) (dbPoolResourceNum config)
+
+connect :: IO Connection
+connect =
+  connectPostgreSQL $ concat [
+  "user='", "admin", "'"
+  , "password='", "admin", "'"
+  , "dbname='", "admin", "'"
+  , "host='", "localhost", "'"
+  , "port='", "15432", "'"
+  ]
+
+-- connectWithLoadConfig :: IO Connection
+-- connectWithLoadConfig = do
+--   c <- loadConfig
+--   connect c
+
+defineTable :: String -> [Name] -> Q [Dec]
+defineTable =
+  defineTableFromDB
+    connect
+    (driverPostgreSQL { typeMap = convTypes })
+    "public"
+
+convTypes :: [(String, TypeQ)]
+convTypes = []
+
+
+runQuery a b = liftIO $ do
+  conn <- liftIO connect
+  runQuery' conn a b
+insertM a b = liftIO connect >>= \conn -> liftIO $ runInsert conn a b >> commit conn
+deleteM a b = liftIO connect >>= \conn -> liftIO $ runDelete conn a b >> commit conn
+updateM a b = liftIO connect >>= \conn -> liftIO $ runUpdate conn a b >> commit conn
diff --git a/app/Entity/Beer.hs b/app/Entity/Beer.hs
new file mode 100644
--- /dev/null
+++ b/app/Entity/Beer.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Entity.Beer where
+
+import           Database.Relational
+import           DataSource2         (defineTable)
+import           GHC.Generics
+import           Prelude             hiding (id)
+
+$(defineTable "beer" [''Show, ''Generic, ''Eq])
diff --git a/app/Entity/BeerImage.hs b/app/Entity/BeerImage.hs
new file mode 100644
--- /dev/null
+++ b/app/Entity/BeerImage.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Entity.BeerImage where
+
+import           Database.Relational
+import           DataSource2         (defineTable)
+import           GHC.Generics
+import           Prelude             hiding (id)
+
+$(defineTable "beer_image" [''Show, ''Generic, ''Eq])
diff --git a/app/Entity/Store.hs b/app/Entity/Store.hs
new file mode 100644
--- /dev/null
+++ b/app/Entity/Store.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Entity.Store where
+
+import           Database.Relational
+import           DataSource2         (defineTable)
+import           GHC.Generics
+import           Prelude             hiding (id)
+
+$(defineTable "store" [''Show, ''Generic, ''Eq])
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedLabels      #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+module Main where
+
+import           Control.Lens
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Data.Default.Class
+import           Data.Generics.Labels     ()
+import           Data.Maybe
+import           Data.Proxy
+import           Data.Text                as T
+import           Database.Relational      as R hiding (fromMaybe, list)
+import           DataSource2
+import           Debug.Trace              (trace)
+import qualified Entity.Beer              as Beer
+import qualified Entity.Store             as Store
+import           GHC.Generics
+import           GHC.Int
+import           Lucid
+import           Network.HTTP.Types       (status404)
+import           Network.Wai
+import           Network.Wai.Handler.Warp (run)
+import           Prelude                  hiding (id)
+import qualified Prelude                  (id)
+import           TypedAdmin
+import           TypedAdmin.Util
+
+instance Default Beer.Beer
+
+instance ToDetail Handler Beer.Beer
+
+instance ToForm Handler Beer.Beer
+
+data BeerDetail = BeerDetail
+  { id   :: Int64
+  , name :: String
+  , ibu  :: Maybe Int32
+  } deriving (Generic)
+
+data UpdateBeerParam = UpdateBeerParam
+  { name :: String
+  , ibu  :: Maybe Int32
+  } deriving (Generic)
+
+instance ToForm Handler UpdateBeerParam
+
+data BeerSummary = BeerSummary
+  { id     :: Int64
+  , name   :: String
+  , images :: [Image]
+  } deriving (Generic, Show)
+
+instance HasHeader BeerSummary
+
+instance ToDetail Handler BeerSummary where
+  linkDetail x =
+    pure $ Just $ "/beers/" <> tshow (x ^. #id)
+  linkEdit x =
+    pure $ Just $ "/beers/" <> tshow (x ^. #id) <> "/_edit"
+
+instance ToDetail Handler BeerDetail
+
+instance ToDetail Handler Store.Store
+instance HasHeader Store.Store
+
+data SearchBeerParam = SearchBeerParam
+  { name :: Maybe String
+  , ibu  :: Maybe Int32
+  } deriving (Generic, Show)
+
+instance ToForm Handler SearchBeerParam
+
+instance ListConsole Handler BeerSummary SearchBeerParam where
+  list p _ = do
+    beers <- runQuery (relationalQuery' (f p) []) ()
+    return $ fmap r beers
+    where
+      f (param :: Maybe SearchBeerParam) = relation $ do
+        x <- query Beer.beer
+        whenJust (param ^? _Just . #name . _Just) $ \v -> wheres $ x ! Beer.name' .=. value v
+        whenJust (param ^? _Just . #ibu . _Just) $ \v -> wheres $ x ! Beer.ibu' .=. just (value v)
+        return x
+      -- mock
+      r x = BeerSummary
+        { id = Beer.id x
+        , name = Beer.name x
+        , images = fmap Image ["https://source.unsplash.com/100x100/?beer"]
+        }
+  listSublayout _ _ b = do
+    div_ [] $
+      a_ [href_ "/beers/_create"] "add new beer"
+    div_ [] b
+
+instance ListConsole Handler Store.Store () where
+  list x _ = runQuery (relationalQuery' Store.store []) ()
+
+instance DetailConsole Handler Beer.Beer where
+  type Ident Beer.Beer = Int64
+  detail i = one <$> runQuery Beer.selectBeer i
+
+instance CreateConsole Handler Beer.Beer Beer.Beer where
+  create _ x = do
+    insertM Beer.insertBeer x
+    pure ()
+  createdRedirectPath _ _ = pure "/beers"
+  detailForCreate _ _ = pure . Just $ def
+
+toDetailUrl x = "/beers/" `append` (pack . show $ Beer.id x)
+
+instance EditConsole Handler BeerDetail UpdateBeerParam where
+  type EditIdent BeerDetail UpdateBeerParam = Int64
+  editedRedirectPath _ _ ident = pure $ "/beers/" <> tshow ident <> "/_edit"
+  detailForEdit _ ident = do
+    b <- one <$> runQuery Beer.selectBeer ident
+    case b of
+      Just b ->
+        return $ Just $ BeerDetail (Beer.id b) (Beer.name b) (Beer.ibu b)
+      Nothing -> return Nothing
+  edit _ ident x = updateM f ()
+    where
+      f :: Update ()
+      f = update $ \proj -> do
+        Beer.name' <-# value (x ^. #name)
+        Beer.ibu' <-# value (x ^. #ibu)
+        wheres $ proj ! Beer.id' .=. value ident
+        return unitPlaceHolder
+
+route :: [Route Handler]
+route =
+  [ ListR "beers" (Proxy :: Proxy BeerSummary) (Proxy :: Proxy SearchBeerParam)
+  , DetailR ("beers" </> var @Int64) (Proxy :: Proxy Beer.Beer)
+  , CreateR "beers" (Proxy :: Proxy Beer.Beer) (Proxy :: Proxy Beer.Beer)
+  , EditR ("beers" </> var @Int64) (Proxy :: Proxy BeerDetail) (Proxy :: Proxy UpdateBeerParam)
+  , ListR "stores" (Proxy :: Proxy Store.Store) (Proxy :: Proxy ())
+  ]
+
+application :: forall b . Request -> (Response -> IO b) -> IO b
+application req res = res $ responseLBS status404 [("Content-Type", "text/plain")] "not found"
+
+serve = do
+  putStrLn "http://localhost:3000/beers"
+  dic <- loadDictionary "i18n.yaml"
+  run 3000 $ admin route Prelude.id Nothing (either (const Nothing) Just dic) application
+main = serve
+
+-- util
+
+memptyToNothing x = if x == mempty then Nothing else Just x
+
+one (x:_) = Just x
+one _     = Nothing
+
+debug lbl x = trace (lbl ++ ": " ++ show x) x
+
+tshow :: Show a => a -> Text
+tshow = pack . show
diff --git a/src/TypedAdmin.hs b/src/TypedAdmin.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin.hs
@@ -0,0 +1,258 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TypedAdmin
+  ( module TypedAdmin.Class
+  , module TypedAdmin.Instance
+  , module TypedAdmin.Router
+  , module TypedAdmin.Extra
+  , module TypedAdmin
+  ) where
+
+import           Control.Monad.State.Class
+import           Control.Monad.State.Strict
+import qualified Data.ByteString.Lazy.UTF8  as LBS
+import qualified Data.ByteString.UTF8       as BS
+import           Data.Maybe
+import           Data.Proxy
+import           Data.Text                  (unpack)
+import           Data.Yaml                  as Y
+import           Lucid
+import           Network.HTTP.Types
+import           Network.Wai
+import           Network.Wai.Parse
+import           TypedAdmin.Class
+import           TypedAdmin.Extra
+import           TypedAdmin.Instance
+import           TypedAdmin.Router
+import           TypedAdmin.Util
+
+type Layout m =  HtmlT m () -> HtmlT m ()
+
+runHandler' ctx a = evalStateT (runHandler a) ctx
+
+admin :: forall m a.
+  MonadState Context m => [Route m]
+  -> (forall x. m x -> Handler x)
+  -> Maybe (Layout m)
+  -> Maybe Dic
+  -> Middleware
+admin rt nt layout dic = \app -> \req res -> do
+  let ctx = Context dic []
+  case (requestMethod req, pathInfo req) of
+    (method, ps) -> do
+      let
+        f "GET" (ListR path p1 p2) =
+          case fromPath path (Prelude.reverse ps) of
+            Just () ->
+              Just $ handleListConsole nt req res (path, ()) layout ctx p1 p2
+            _ -> Nothing
+        f "GET" (DetailR path p1) = do
+          case fromPath path (Prelude.reverse ps) of
+            Just x ->
+              Just $ handleDetailConsole nt req res p1 ctx x
+            _ -> Nothing
+        f "GET" (CreateR path p1 p2) = do
+          case fromPath (StaticP "_create" path) (Prelude.reverse ps) of
+            Just () ->
+              Just $ handleCreateConsole nt req res (path, ()) layout ctx p1 p2
+            _ -> Nothing
+        f "POST" (CreateR path p1 p2) = do
+          case fromPath (path) (Prelude.reverse ps) of
+            Just () ->
+              Just $ handleCreate nt req res p1 p2 ctx
+            _ -> Nothing
+        f "GET" (EditR path p1 p2) = do
+          case fromPath (StaticP "_edit" path) (reverse ps) of
+            Just x ->
+              Just $ handleEditConsole nt req res (path, x) layout p1 p2 ctx x
+            _ -> Nothing
+        f "POST" (EditR path p1 p2) = do
+          handleEdit nt req res p1 p2 ctx <$> fromPath path (reverse ps)
+        f "POST" (DeleteR path p1) = do
+          case fromPath (StaticP "_delete" path) (reverse ps) of
+            Just x ->
+              Just $ handleDelete nt req res p1 ctx x
+            _ -> Nothing
+        f _ _ = Nothing
+      case firstJust (f method) rt of
+        Just h  -> h
+        Nothing -> app req res
+
+-- newtype Handler a = Handler { runHandler :: IO a }
+
+contentType = ("Content-Type", "Content-type: text/html; charset=UTF-8")
+
+-- todo:: receive func like (m - IO)
+
+handleListConsole :: forall proxy1 proxy2 p1 p2 z m a b.
+  (ListConsole m p1 p2, PathParam a b, MonadState Context m)
+  => (forall x . m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> (a, b)
+  -> Maybe (Layout m)
+  -> Context
+  -> proxy1 p1
+  -> proxy2 p2
+  -> IO z
+handleListConsole nt req res (path, param) layout ctx _ _ = do
+  let query = queryString req
+  let page = fromMaybe 0 $ lookupMaybe "page" query
+  let
+    f :: m LBS.ByteString
+    f = do
+      p <- r2m <$> fromForm query
+      beers <- (list :: (Maybe p2) -> Page -> m ([p1])) p page
+      mtotal <- total p (Proxy :: Proxy p1)
+      let body = renderListHtml beers p (path, param, query) (page, mtotal)
+      renderBST $ (fromMaybe defaultLayout layout) body
+  body <- runHandler' ctx $ nt f
+  res $
+    responseLBS status200 [contentType] body
+
+r2m (Right x) = Just x
+r2m _         = Nothing
+
+handleDetailConsole :: forall proxy1 p1 b m.
+  (DetailConsole m p1,  MonadState Context m)
+  => (forall x . m x -> Handler x)
+  -> Request
+  -> (Response -> IO b)
+  -> proxy1 p1
+  -> Context
+  -> Ident p1
+  -> IO b
+handleDetailConsole nt req res _ ctx rid = do
+  mbody <- runHandler' ctx $ nt $ do
+    mr <- detail rid :: m (Maybe p1)
+    case mr of
+      Just r -> do
+        Just <$> renderBST (renderDetailHtml r)
+      Nothing -> pure Nothing
+  case mbody of
+     Just x ->
+       res $ responseLBS status200 [("Content-Type", "text/html")] x
+     Nothing ->
+       res404 res
+
+handleCreateConsole :: forall proxy1 proxy2 a b z m c d.
+  (CreateConsole m a b, PathParam c d)
+  => (forall x. m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> (c, d)
+  -> Maybe (Layout m)
+  -> Context
+  -> proxy1 a
+  -> proxy2 b
+  -> IO z
+handleCreateConsole nt req res path layout ctx _ _ = do
+  let query = queryString req
+  body <- runHandler' ctx $ nt $ do
+    mr <- detailForCreate query (Proxy :: Proxy b) :: m (Maybe a)
+    case mr of
+      Just r ->
+        Just <$> (renderBST $ (fromMaybe defaultLayout layout) (toCreateForm r (Proxy :: Proxy b) path))
+      Nothing ->
+        pure Nothing
+  case body of
+    Just x ->
+      res $ responseLBS status200 [contentType] x
+    Nothing -> res404 res
+
+handleCreate :: forall proxy1 proxy2 a b z m. (CreateConsole m a b)
+  => (forall x. m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> proxy1 a
+  -> proxy2 b
+  -> Context
+  -> IO z
+handleCreate nt req res _ _ ctx = do
+  (ps, _) <- parseRequestBody lbsBackEnd req
+  mx <- runHandler' ctx $ nt $ fromForm (mapSnd Just <$> ps)
+  case mx of
+    Right x -> do
+      path <- runHandler' ctx $ nt $ do
+        create (Proxy :: Proxy a) (x :: b)
+        createdRedirectPath (Proxy :: Proxy a) (x :: b)
+      res $ responseLBS status302 [contentType, ("Location", BS.fromString $ unpack path)] "not found"
+    Left x -> res400 res (LBS.fromString x)
+
+handleEditConsole :: forall proxy1 proxy2 a b c d z m.
+  (EditConsole m a b, PathParam c d, MonadState Context m)
+  => (forall x. m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> (c, d)
+  -> Maybe (Layout m)
+  -> proxy1 a
+  -> proxy2 b
+  -> Context
+  -> EditIdent a b
+  -> IO z
+handleEditConsole nt req res path layout _ _ ctx rid = do
+  body <- runHandler' ctx $ nt $ do
+    mr <- detailForEdit (Proxy :: Proxy b) rid :: m (Maybe a)
+    case mr of
+      Just r ->
+        renderBST $ (fromMaybe defaultLayout layout) (renderEditHtml r (Proxy :: Proxy b) rid path)
+  res $
+    responseLBS status200 [contentType] body
+
+handleEdit :: forall proxy1 proxy2 a b z m. (EditConsole m a b)
+  => (forall x. m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> proxy1 a
+  -> proxy2 b
+  -> Context
+  -> EditIdent a b
+  -> IO z
+handleEdit nt req res _ _ ctx rid = do
+  (ps, _) <- parseRequestBody lbsBackEnd req
+  mx <- runHandler' ctx $ nt $ fromForm (mapSnd Just <$> ps)
+  case mx of
+    Right x -> do
+      editP <- runHandler' ctx $ nt $ do
+        edit (Proxy :: Proxy a) rid (x :: b)
+        editedRedirectPath (Proxy :: Proxy a) (Proxy :: Proxy b) rid
+      res $ responseLBS status302 [contentType, ("Location", BS.fromString $ unpack editP)] "not found"
+    Left x -> res400 res (LBS.fromString x)
+
+handleDelete :: forall proxy1 a z m. (DeleteConsole m a)
+  => (forall x. m x -> Handler x)
+  -> Request
+  -> (Response -> IO z)
+  -> proxy1 a
+  -> Context
+  -> DeleteIdent a
+  -> IO z
+handleDelete nt req res _ ctx rid = do
+  (ps, _) <- parseRequestBody lbsBackEnd req
+  mx <- runHandler' ctx $ nt $ fromForm (mapSnd Just <$> ps)
+  case mx of
+    Right x -> do
+      editP <- runHandler' ctx $ nt $ do
+        delete rid (x :: a)
+        deletedRedirectPath rid x
+      res $ responseLBS status302 [contentType, ("Location", BS.fromString $ unpack editP)] "not found"
+    Left x -> res400 res (LBS.fromString x)
+
+res400 res str = res $ responseLBS status400 [("Content-Type", "text/plain")] str
+res404 res = res $ responseLBS status404 [("Content-Type", "text/plain")] "not found"
+
+defaultLayout :: Monad m => HtmlT m a -> HtmlT m a
+defaultLayout x = do
+  doctypehtml_ $ do
+    head_ [] $ return ()
+    body_ [] x
+
+loadDictionary :: FilePath -> IO (Either ParseException Dic)
+loadDictionary path = do
+  decodeFileEither path
diff --git a/src/TypedAdmin/Class.hs b/src/TypedAdmin/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin/Class.hs
@@ -0,0 +1,176 @@
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DuplicateRecordFields      #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
+
+module TypedAdmin.Class where
+
+import           Control.Monad.Base            (MonadBase)
+import           Control.Monad.Catch           hiding (Handler)
+import           Control.Monad.IO.Class
+import           Control.Monad.State.Class
+import           Control.Monad.State.Strict
+import           Control.Monad.Trans.Control   (MonadBaseControl)
+import           Data.ByteString
+import           Data.Generics.Product.Subtype
+import           Data.Proxy
+import           Data.Text                     (Text)
+import qualified Data.Yaml                     as Y
+import           GHC.Generics
+import           Lucid                         (HtmlT (..))
+import           Network.HTTP.Types
+
+
+type PathText = Text
+type Page = Int
+
+type Dic = Y.Object
+data Context = Context
+  { dic             :: Maybe Dic
+  , localeHierarchy :: [Text]
+  }
+class MonadState Context m => L18N m
+
+-- class Monad m => MonadState' r (m :: * -> *) | m -> r where
+--   ask' :: m r
+--   local' :: (r -> r) -> m a -> m a
+--   reader' :: (r -> a) -> m a
+
+-- instance Monad m => MonadState' r (ReaderT r m) where
+--   ask' = ask
+--   local' = local
+--   reader' = reader
+
+-- instance MonadState' r m => MonadState' r (HtmlT m) where
+--   ask' = lift ask'
+--   local' f a = a
+
+-- asks' :: MonadState' r m => (r -> a) -> m a
+-- asks' = reader'
+
+newtype Handler a = Handler
+  { runHandler :: StateT Context IO a
+  } deriving
+  ( Functor
+  , Applicative
+  , Monad
+  , MonadIO
+  , MonadState Context
+  , MonadBase IO
+  , MonadBaseControl IO
+  , MonadThrow
+  , MonadCatch
+  )
+
+-- class ToName a where
+--   toName :: proxy a -> Text
+
+class HasHeader a where
+  hasHeader :: (Monad m, MonadState Context m) => proxy a -> [HtmlT m ()]
+  default hasHeader:: (Monad m, MonadState Context m, Generic a, GHasHeader (Rep a)) => proxy a -> [HtmlT m ()]
+  hasHeader x = gHasHeader (Proxy :: Proxy (Rep a))
+
+class GHasHeader (f :: * -> *) where
+  gHasHeader :: (Monad m, MonadState Context m) => proxy f -> [HtmlT m ()]
+
+class ToDetailField a where
+  toDetailField :: Monad m => a -> HtmlT m ()
+
+class MonadIO m => ToDetail m f where
+  toDetail :: f -> m [(Text, HtmlT m ())]
+  default toDetail :: (Generic f, GToDetail (Rep f)) => f -> m [(Text, HtmlT m ())]
+  toDetail x = do
+    gToDetail (from x)
+    -- case linkDetail x of
+    --   Just p ->
+    --     td_ [] $ a_ [href_ p] "detail"
+    --   Nothing -> return ()
+  linkDetail :: f -> m (Maybe PathText)
+  linkDetail _ = return Nothing
+  linkEdit :: f -> m (Maybe PathText)
+  linkEdit _ = return Nothing
+  detailTitle :: proxy f -> m Text
+  default detailTitle :: (Generic f, GToDetail (Rep f)) => proxy f -> m Text
+  detailTitle x = gDetailTitle (Proxy :: Proxy (Rep f))
+
+class GToDetail (f :: * -> *) where
+  gToDetail :: (MonadIO m, Monad m2) => f a -> m [(Text, HtmlT m2 ())]
+  gDetailTitle :: (Monad m) => proxy f -> m Text
+
+class Monad m =>  ToForm m a where
+  toForm :: Maybe a -> m [(Text, HtmlT m ())]
+  default toForm :: (Generic a, GToForm m (Rep a)) => Maybe a -> m [(Text, HtmlT m ())]
+  toForm x = gToForm (from <$> x)
+  fromForm :: [(ByteString, Maybe ByteString)] -> m (Either String a)
+  default fromForm :: (Generic a, GToForm m (Rep a)) => [(ByteString, Maybe ByteString)] -> m (Either String a)
+  fromForm x = fmap to <$> gFromForm x
+
+class Monad m => GToForm m (f :: * -> *) where
+  gToForm :: Maybe (f a) -> m [(Text, HtmlT m ())]
+  gFromForm :: [(ByteString, Maybe ByteString)] -> m (Either String (f a))
+
+class Monad m => FormField m a where
+  toFormField :: Text -> Maybe a -> HtmlT m ()
+  fromFormField :: [(ByteString, Maybe ByteString)] -> ByteString -> m (Maybe a)
+
+-- todo: wrap [a]
+class (HasHeader a, ToDetail m a, ToForm m b) => ListConsole m a b where
+  list :: (Maybe b) -> Page -> m ([a])
+  total :: Maybe b -> proxy a -> m (Maybe Int)
+  total _ _ = pure Nothing
+  listSublayout :: Maybe b -> [a] -> HtmlT m () -> HtmlT m ()
+  listSublayout _ _ x = x
+-- todo wrap a
+
+class (ToDetail m a, Read (Ident a)) => DetailConsole m a where
+  type Ident a
+  detail :: Ident a -> m (Maybe a)
+  detailSublayout :: a -> HtmlT m () -> HtmlT m ()
+  detailSublayout _ x = x
+
+-- class (ToForm m a, MonadIO m) => CreateConsole m a where
+--   create :: a -> m ()
+--   createPath :: proxy a -> m (PathText, PathText)
+
+-- todo: edit, createを抽象化
+-- editのみroute parameterを受け取っているのは間違い
+-- note:
+-- 小リソースの作成など、作成時に固定で使う値があるため、
+-- 作成に使うデータbが、読み込むデータaのsubsetになっている。
+-- ただし、aに値を設定する必要がない場合がほとんどであり、使いにくいかも（defで対応している）
+-- フォームにできる時点で初期値を持てると言う意味かも
+class (ToDetail m a, ToForm m b, Subtype b a) => CreateConsole m a b where
+  create :: proxy a -> b -> m ()
+  createdRedirectPath :: proxy a -> b -> m PathText
+  -- createPath :: a -> proxy b -> m PathText
+  detailForCreate :: Query -> proxy b -> m (Maybe a)
+  createSublayout :: proxy b -> a -> HtmlT m () -> HtmlT m ()
+  createSublayout _ _ x = x
+
+class (ToDetail m a, ToForm m b, Read (EditIdent a b), Subtype b a) => EditConsole m a b where
+  type EditIdent a b
+  edit :: proxy a -> EditIdent a b -> b -> m () -- todo: use AllowAmbiguousTypes and TypeApplication?
+  -- editPath :: proxy a -> proxy b -> EditIdent a b -> m (PathText, PathText)
+  editedRedirectPath :: proxy a -> proxy b -> EditIdent a b -> m PathText
+  detailForEdit :: proxy b -> EditIdent a b -> m (Maybe a)
+  sublayout :: proxy b -> a -> HtmlT m () -> HtmlT m ()
+  sublayout _ _ x = x
+
+
+class (Monad m, ToForm m a) => DeleteConsole m a where
+  type DeleteIdent a
+  delete :: DeleteIdent a -> a -> m ()
+  deletedRedirectPath :: DeleteIdent a -> a -> m PathText
+
+-- todo: /storeを対応、commentとかに変えて子コードにしてみる
+-- todo: layout改善
+-- todo: Console間のリンクを改善
diff --git a/src/TypedAdmin/Extra.hs b/src/TypedAdmin/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin/Extra.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TemplateHaskell            #-}
+module TypedAdmin.Extra where
+
+import           Control.Monad
+import           Control.Monad.Trans.Class
+import           Data.ByteString.Lazy      (toStrict)
+import qualified Data.ByteString.UTF8      as BS
+import           Data.Default.Class
+import           Data.Maybe
+import           Data.Text                 (pack)
+import           Data.Text                 (Text)
+import           Data.Text.Encoding        (decodeUtf8)
+import           GHC.Generics
+import           GHC.Int
+import           Lucid
+import           Text.Blaze.Renderer.Utf8  (renderMarkup)
+import           Text.Heterocephalus
+import           TypedAdmin.Class
+import           TypedAdmin.Instance       ()
+import           TypedAdmin.Util
+
+newtype Image = Image { unImage :: String }
+  deriving (Show)
+
+instance ToDetailField Image where
+  toDetailField (Image x) = do
+    a_ [href_ (pack x), target_ "_blank"] $
+      img_ [src_ (pack x)]
+
+newtype HiddenField a = HiddenField { unHiddenField :: a }
+  deriving (Generic, Show)
+
+instance Monad m => FormField m (HiddenField String) where
+  toFormField n x = input_ [type_ "hidden", name_ n, value_ (pack $ fromMaybe "" $ unHiddenField <$> x)]
+  fromFormField ps k = pure $ fmap HiddenField $ memptyToNothing =<< BS.toString <$> join (lookup k ps)
+
+instance Monad m => FormField m (HiddenField Int64) where
+  toFormField n x = input_ [type_ "text", name_ n, value_ (pack $ fromMaybe "" $ show . unHiddenField <$> x)]
+  fromFormField ps k = pure $ fmap HiddenField $ lookupMaybe k ps
+
+data Anchor a = Anchor a Text
+
+instance ToDetailField a => ToDetailField (Anchor a) where
+  toDetailField (Anchor x url) = do
+    a_ [href_ url] $ toDetailField x
+
+newtype TextArea = TextArea { unTextArea :: String }
+  deriving (Show, Default)
+
+instance Monad m => FormField m TextArea where
+  toFormField n x = textarea_ [name_ n] $
+    toHtml $ fromMaybe "" $ unTextArea <$> x
+  fromFormField ps k = pure $ fmap TextArea $ memptyToNothing =<< BS.toString <$> join (lookup k ps)
+
+newtype RangeField a = RangeField { unRangeField :: a }
+  deriving (Show, Default)
+
+instance (Monad m, Bounded a, Enum a) => FormField m (RangeField a) where
+  toFormField n x = input_ [ type_ "range", name_ n
+                           , value_ (pack $ fromMaybe "" $ show . fromEnum . unRangeField <$> x)
+                           , step_ "1"
+                           , min_ (pack . show $ fromEnum (minBound :: a))
+                           , max_ (pack . show $ fromEnum (maxBound :: a))]
+  fromFormField ps k = pure $ fmap (RangeField . toEnum) $ lookupMaybe k ps
+
+
+class GoogleApiEnv m where
+  getKey :: m String
+
+data GeoLocation = GeoLocation
+  { lat :: Double
+  , lon :: Double
+  } deriving (Show, Generic)
+instance Default GeoLocation
+
+instance (Monad m, GoogleApiEnv m) => FormField m GeoLocation where
+  toFormField n v = do
+    let vlat = maybe "" (pack . show . lat) v
+    input_ [type_ "text", id_ "locationLat", name_ (n <> "lat"), value_ vlat]
+    let vlon = maybe "" (pack . show . lon) v
+    input_ [type_ "text", id_ "locationLon", name_ (n <> "lon"), value_ vlon]
+    div_ [id_ "map", style_ "height: 400px;"] ""
+    script_ (decodeUtf8 $ toStrict $ renderMarkup $(compileTextFile "templates/javascript/map.js"))
+    key <- lift $ getKey
+    script_ [src_ ("https://maps.googleapis.com/maps/api/js?key=" <> pack key <> "&callback=initMap")] ("" :: String)
+   -- async defer></script>
+  fromFormField ps k = do
+    lat <- fromFormField ps (k <> "lat")
+    lon <- fromFormField ps (k <> "lon")
+    return $ GeoLocation <$> lat <*> lon
diff --git a/src/TypedAdmin/Instance.hs b/src/TypedAdmin/Instance.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin/Instance.hs
@@ -0,0 +1,457 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+module TypedAdmin.Instance where
+
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.State.Class
+import           Control.Monad.Trans.Class
+import qualified Data.ByteString.UTF8          as BS
+import           Data.Generics.Product.Subtype
+import qualified Data.HashMap.Strict           as M
+import           Data.Maybe
+import           Data.Proxy
+import           Data.Text                     as T (Text, dropWhile, pack)
+import           Data.Time
+import           Data.Yaml                     as Y
+import           GHC.Generics
+import           GHC.Int
+import           Lucid
+import           Network.HTTP.Types.URI        (Query, renderQuery)
+import           TypedAdmin.Class
+import           TypedAdmin.Router
+import           TypedAdmin.Util
+
+pushH :: MonadState Context m => Text -> m a -> m a
+pushH k f = do
+  modify (\x -> x { localeHierarchy = k:localeHierarchy x})
+  r <- f
+  modify (\x -> x { localeHierarchy = Prelude.tail (localeHierarchy x)})
+  return r
+
+toLocal :: MonadState Context m => Text -> m Text
+toLocal k = do
+  dic <- dic <$> get
+  h <- localeHierarchy <$> get
+  let k' = T.dropWhile (== '_') k
+  let f d [] h k'' =
+        case (M.lookup k'' =<< d, h) of
+          (Just (Y.String x), _)     -> return x
+          (_, _:h')                  -> f dic h' h' k''
+          (Just (Y.Object dic'), []) -> f (Just dic') [] [] "."
+          (_, [])                    -> return (if k'' == "." then k' else k'')
+      f d (h':hs) h k'' =
+        case M.lookup h' =<< d of
+          Just (Y.Object dic') -> f (Just dic') hs h k''
+          _                    -> f dic (tail h) (tail h) k''
+  f dic h h k'
+
+-- instance {-# OVERLAPS #-} (Show a) => ToHtml a where
+--   toHtml = toHtml . show
+--   toHtmlRaw = toHtmlRaw .show
+
+-- instance ToHtml a => ToHtml (Maybe a) where
+--   toHtml x = Data.Maybe.fromMaybe (toHtml ("" :: String)) $ toHtml <$> x
+--   toHtmlRaw = toHtmlRaw
+
+instance ToDetailField String where
+  toDetailField x = span_ [] (toHtml x)
+
+instance ToDetailField Bool where
+  toDetailField x = span_ [] (toHtml (show x))
+
+instance ToDetailField Integer where
+  toDetailField x = span_ [] (toHtml (show x))
+instance ToDetailField Int where
+  toDetailField x = toDetailField (fromIntegral x :: Integer)
+instance ToDetailField Int32 where
+  toDetailField x = toDetailField (fromIntegral x :: Integer)
+instance ToDetailField Int64 where
+  toDetailField x = toDetailField (fromIntegral x :: Integer)
+
+instance ToDetailField Day where
+  toDetailField x = span_ [] (toHtml (show x))
+
+instance ToDetailField UTCTime where
+  toDetailField x = span_ [] (toHtml (show x))
+
+instance ToDetailField LocalTime where
+  toDetailField x = span_ [] (toHtml (show x))
+
+instance ToDetailField a => ToDetailField (Maybe a) where
+  toDetailField x = fromMaybe (span_ [] "")$ toDetailField <$> x
+
+instance {-# OVERLAPPABLE #-} ToDetailField a => ToDetailField [a] where
+  toDetailField xs = do
+    ul_ [] $
+      forM_ (toDetailField <$> xs) $ \x -> do
+        li_ [] x
+
+instance {-# OVERLAPPABLE #-} (Show a) =>  ToDetailField a where
+  toDetailField x = span_ [] (toHtml $ show x)
+
+-- instance GToDetail V1 where
+--   gToDetail _ = error "toRow V1"
+
+-- instance GToDetail U1 where
+--   gToDetail _ = error "toRow U1"
+
+instance (GToDetail f, GToDetail g) => GToDetail (f :*: g) where
+  gToDetail (f :*: g) = do
+    x <- gToDetail f
+    y <- gToDetail g
+    return $ x <> y
+  gDetailTitle _ = pure "*"
+
+-- instance (GToDetail f, GToDetail g) => GToDetail (f :+: g) where
+--   gToDetail _ = error "toRow sum type"
+
+instance (ToDetailField c, Selector s) => GToDetail (M1 S s (K1 i c)) where
+  gToDetail x =
+    let (M1 (K1 c)) = x
+    in return [(pack (selName x), toDetailField c)]
+  gDetailTitle _ = pure "--"
+
+instance {-# OVERLAPPABLE #-} (GToDetail f, Constructor c) => GToDetail (M1 C c f) where
+  gToDetail (M1 x) = do
+    gToDetail x
+  gDetailTitle x = pure $ pack $ conName (undefined :: M1 C c rep ())
+
+instance {-# OVERLAPPABLE #-} (GToDetail f) => GToDetail (M1 i t f) where
+  gToDetail (M1 x) = do
+    gToDetail x
+  gDetailTitle _ = gDetailTitle (Proxy :: Proxy f)
+  -- gDetailTitle x = pure $ pack $ conName (undefined :: M1 C t f ())
+
+-- instance  {-# OVERLAPS #-} (ToDetail a, HasHeader a) => ToHtml [a] where
+--   toHtml xs = do
+--     table_ $ do
+--       tr_ $ mapM_ th_ $ hasHeader (Proxy :: Proxy a)
+--       forM_ xs $ (tr_ []) . toRow
+--   toHtmlRaw = toHtml
+
+-- instance GHasHeader V1 where
+--   gHasHeader _ = error "hasHeader V1"
+
+-- instance GHasHeader U1 where
+--   gHasHeader _ = error "hasHeader U1"
+
+instance (GHasHeader f, GHasHeader g) => GHasHeader (f :*: g) where
+  gHasHeader _ = gHasHeader (Proxy :: Proxy f) ++ gHasHeader (Proxy :: Proxy g)
+
+-- instance GHasHeader (f :+: g) where
+--   gHasHeader _ = error "hasHeader sum type"
+
+-- instance GHasHeader (K1 i c) where
+--   gHasHeader (K1 x) = error "K1"
+
+instance (Selector s) => GHasHeader (M1 S s k) where
+  gHasHeader _ =
+    [ do
+        l <- lift $ toLocal $ pack $ selName (undefined :: t s k a)
+        toHtml l
+    ]
+instance GHasHeader f => GHasHeader (M1 C t f) where
+  gHasHeader _ = gHasHeader (Proxy :: Proxy f)
+
+instance GHasHeader f => GHasHeader (M1 D t f) where
+  gHasHeader _ = gHasHeader (Proxy :: Proxy f)
+
+instance (GToForm m f, GToForm m g) => GToForm m (f :*: g) where
+  gToForm (Just (f :*: g)) = do
+    x <- gToForm (Just f)
+    y <- gToForm (Just g)
+    return $ x ++ y
+  gToForm _ = do
+    x <- gToForm (Nothing :: Maybe (f a))
+    y <- gToForm (Nothing :: Maybe (g a))
+    return $ x ++ y
+  gFromForm ps = do
+    x <- (gFromForm ps)
+    y <- (gFromForm ps)
+    pure $ liftA2 (:*:) x y
+
+instance GToForm m f => GToForm m (M1 D t f) where
+  gToForm (Just (M1 x)) = gToForm (Just x)
+  gToForm _             = gToForm (Nothing :: Maybe (f a))
+  gFromForm ps = do
+    x <- gFromForm ps
+    pure $ M1 <$> x
+
+instance GToForm m f => GToForm m (M1 C t f) where
+  gToForm (Just (M1 x)) = gToForm (Just x)
+  gToForm _             = gToForm (Nothing :: Maybe (f a))
+  gFromForm ps = do
+    x <- gFromForm ps
+    pure $ M1 <$> x
+
+instance forall s m c i. (Selector s, FormField m c) => GToForm m (M1 S s (K1 i c)) where
+  gToForm x = do
+    let k = (\(M1 (K1 k)) -> k) <$> x
+        sname = selName (undefined :: t s (K1 i (Maybe a)) p)
+    pure [(pack sname, toFormField (pack $ sname) k)]
+  gFromForm ps = do
+    let sname = selName (undefined :: t s (K1 i (Maybe a)) p)
+    mx <- fromFormField ps (BS.fromString $ sname)
+    pure $ case mx of
+      Just x  -> Right $ M1 $ K1 x
+      Nothing -> Left ("--GToForm--" <> show ps <> sname)
+
+instance Monad m => FormField m String where
+  toFormField n x = input_ [type_ "text", name_ n, value_ (pack $ fromMaybe "" x), required_ ""]
+  fromFormField ps k = pure (BS.toString <$> join (lookup k ps))
+
+instance {-# OVERLAPPING #-} Monad m => FormField m (Maybe String) where
+  toFormField n x = input_ [type_ "text", name_ n, value_ (pack $ fromMaybe "" $ join x)
+                           , class_ "maybe"]
+  fromFormField ps k =
+    let x = BS.toString <$> join (lookup k ps)
+    in pure $ Just $ memptyToNothing =<< x
+
+instance Monad m => FormField m Bool where
+  toFormField n x =
+    let chkd = if (fromMaybe False x) then [checked_] else []
+    in input_ $ [type_ "checkbox", name_ n] ++ chkd
+  fromFormField ps k = pure $ Just $ isJust $ join (lookup k ps)
+
+-- instance {-# OVERLAPS #-} (Integral a, Show a, Read a) => FormField a where
+--   toFormField n x = input_ [type_ "number", name_ n, value_ (pack $ fromMaybe "" (show <$> x))]
+--   fromFormField ps k = lookupMaybe k ps
+
+toHtmlInput t n x = input_ [type_ t, name_ n, value_ (pack $ fromMaybe "" (show <$> x))]
+fromHtmlInput ps k = pure $ lookupMaybe k ps
+
+-- todo: Read,ShowなものはすべてtoTypeAttr実装し共通実装では？
+instance Monad m => FormField m Int where
+  toFormField = toHtmlInput "number"
+  fromFormField = fromHtmlInput
+
+instance Monad m =>  FormField m Int32 where
+  toFormField = toHtmlInput "number"
+  fromFormField = fromHtmlInput
+
+instance Monad m => FormField m Int64 where
+  toFormField = toHtmlInput "number"
+  fromFormField = fromHtmlInput
+
+instance Monad m => FormField m Double where
+  toFormField = toHtmlInput "text"
+  fromFormField = fromHtmlInput
+
+instance Monad m => FormField m Day where
+  toFormField = toHtmlInput "date"
+  fromFormField = fromHtmlInput
+
+instance FormField m a => FormField m (Maybe a) where
+  toFormField n x = toFormField n (join x)
+  fromFormField ps k = do
+    x <- fromFormField ps k
+     -- todo: Justが出てくる箇所多分型間違ってるので、見直す
+    pure $ Just x
+
+newtype SelectForm a = SelectForm { unSelectForm :: a}
+  deriving (Show)
+
+
+selectFormField' :: forall a m.
+  (Enum a, Bounded a, Show a, Read a, Monad m) =>
+  Bool -> Text -> Maybe (SelectForm a) -> HtmlT m ()
+selectFormField' required n x = do
+  let min = minBound :: a
+      max = maxBound :: a
+  select_ [name_ n] $ do
+    when (not required) $ option_ [value_ ""] ""
+    forM_ [min .. max] $ \o -> do
+      let sed = case x of
+            Just (SelectForm x)
+              | fromEnum o == fromEnum x -> [selected_ ""]
+              | otherwise -> []
+            _ -> []
+      option_ ([value_ $ pack $ show $ fromEnum o] ++ sed) $ toHtml $ show o
+
+fromSelectFormField ps k = pure $ fmap (SelectForm . toEnum) $ lookupMaybe k ps
+
+instance {-# OVERLAPPING #-} (Enum a, Bounded a, Show a, Read a, Monad m) => FormField m (Maybe (SelectForm a)) where
+  toFormField n x = selectFormField' False n (join x)
+  fromFormField ps k = Just <$> fromSelectFormField ps k
+
+instance (Enum a, Bounded a, Show a, Read a, Monad m) => FormField m (SelectForm a) where
+  toFormField n x = selectFormField' True n x
+  fromFormField = fromSelectFormField
+
+
+instance Monad m => ToForm m () where
+  toForm _ = pure mempty
+  fromForm _ = pure $ pure mempty
+
+renderListHtml ::
+  forall a b c d m . (Monad m, ListConsole m a b, PathParam c d, MonadState Context m)
+  => [a]
+  -> Maybe b
+  -> (c, d, Query)
+  -> (Int, Maybe Int)
+  -> HtmlT m ()
+renderListHtml xs p (path, param, query) (page, total) = do
+  let pathText = toText $ renderPath path param
+  -- liftIO $ print $ show (Proxy :: Proxy a)
+  let hs = hasHeader (Proxy :: Proxy a)
+  title <- lift $ detailTitle (Proxy :: Proxy a)
+  title' <- toLocal title
+  h1_ [] $ toHtml $ title'
+  listSublayout p xs $ do
+    pushH title $ do
+      form_ [method_ "GET", action_ pathText, class_ "_typed_admin_search_form"] $ do
+        form <- lift $ toForm p
+        div_ [class_ "_typed_admin_fields"] $ do
+          forM_ form $ \(name, fld) -> do
+            div_ [] $ do
+              dt_ [] $ do
+                name' <- toLocal name
+                label_ [] (toHtml name')
+              dd_ [] $
+                  fld
+        div_ [class_ "_typed_admin_actions"] $ do
+          dt_ [] "action"
+          dd_ [] $ do
+            lblSearch <- toLocal "search"
+            input_ [type_ "submit", value_ lblSearch]
+      table_ [] $ do
+        thead_ [] $
+          tr_ $ mapM_ th_ hs
+        tbody_ [] $ do
+          forM_ xs $ \row -> do
+            detail <- lift $ toDetail row
+            tr_ [] $ do
+              forM_ detail $ \(n, cell) -> do
+                td_ [class_ ("_typed_admin_td_" <> n)] cell
+              td_ [class_ "_typed_admin_actions"] $
+                ul_ [] $ do
+                  editLbl <- toLocal "edit"
+                  forM_ [("detail", linkDetail), (editLbl, linkEdit)] $ \(l, g) -> do
+                    mp <- lift $ g row
+                    ll <- toLocal l
+                    whenJust mp $ \p -> li_ [] $ a_ [href_ p] $ toHtml ll
+              --     forM_ (catMaybes
+              --            [ (\u -> a_ [href_ u] "detail") <$> linkDetail row
+              --            , (\u -> a_ [href_ u] "edit") <$> linkEdit row
+              --            ]
+              --           ) $ \a -> li_ [] a
+      div_ [class_ "_typed_admin_pager"] $ do
+        let rQuery q = pack (BS.toString (renderQuery True q))
+            pageQ d = rQuery (setPageQuery (page + d) query)
+        when (page > 0) $
+          a_ [href_ (pathText <> pageQ (-1))] "prev"
+        whenJust total $ \t ->
+          forM_ [0..(t - 1)] $ \p -> do
+            let sp = toHtml $ show (p + 1)
+            if page == p
+            then
+              span_ $ sp
+            else
+              a_ [href_ (pathText <> rQuery (setPageQuery p query))] sp
+        a_ [href_ (pathText <> pageQ 1)] "next"
+
+setPageQuery page query =
+  let p = ("page", Just $ BS.fromString $ show (page))
+  in p:(filter ((/= "page") . fst) query)
+
+renderDetailHtml :: forall a b m .
+  (Monad m, DetailConsole m a, MonadState Context m)
+  => a -> HtmlT m ()
+renderDetailHtml x = do
+  title <- lift $ detailTitle (Proxy :: Proxy a)
+  title' <- toLocal title
+  detail <- lift $ toDetail x
+  div_ [class_ ("_typed_admin_detail_" <> title)] $ do
+    h1_ [] $ toHtml $ title'
+    detailSublayout x $ do
+      pushH title $ do
+        dl_ [] $ do
+          forM_ detail $ \(name, field) -> do
+            dt_ [] (toHtml name)
+            dd_ [] field
+
+toCreateForm :: forall a b c d proxy m .
+  (Monad m, CreateConsole m a b, PathParam c d)
+  => a
+  -> proxy b
+  -> (c, d)
+  -> HtmlT m ()
+toCreateForm x _ (path, param) = do
+  detail <- lift $ toDetail x
+  form <- lift $ toForm (Just (upcast x :: b))
+  let pathText = toText $ renderPath path param
+  let r =
+        form_ [method_ "POST", action_ pathText] $ do
+          dl_ $ do
+            forM_ detail $ \(name, detailField) -> do
+              dt_ [] $
+                label_ [] (toHtml name)
+              dd_ [] $
+                fromMaybe (detailField) $ lookup name form
+            tr_ $
+              p_ [] "actions"
+            dd_ $
+              input_ [type_ "submit"]
+  createSublayout (Proxy :: Proxy b) x r
+
+renderEditHtml :: forall a b c d proxy m .
+  (Monad m, EditConsole m a b, PathParam c d, MonadState Context m)
+  => a
+  -> proxy b
+  -> EditIdent a b
+  -> (c, d)
+  -> HtmlT m ()
+renderEditHtml x _ ident (path, param) = do
+  title <- lift $ detailTitle (Proxy :: Proxy a)
+  title' <- toLocal title
+  div_ [class_ ("_typed_admin_detail_" <> title)] $ do
+    h1_ [] $ toHtml $ title'
+    detail <- lift $ toDetail x
+    form <- lift $ toForm (Just (upcast x :: b))
+    let pathText = toText $ renderPath path param
+    sublayout (Proxy :: Proxy b) x $ do
+      form_ [method_ "POST", action_ pathText] $ do
+        dl_ $ do
+          forM_ detail $ \(name, detailField) -> do
+            dt_ [] $ do
+              name' <- toLocal name
+              label_ [] (toHtml name')
+            dd_ [] $
+              fromMaybe (detailField) $ lookup name form
+          tr_ $ do
+            lblActions <- toLocal "actions"
+            p_ [] (toHtml lblActions)
+          dd_ $
+            input_ [type_ "submit"]
+
+renderDeleteHtml :: forall a b c d proxy m .
+  (Monad m, DeleteConsole m a, PathParam c d, MonadState Context m)
+  => DeleteIdent a
+  -> a
+  -> (c, d)
+  -> HtmlT m ()
+renderDeleteHtml ident x (path, param) = do
+  form <- lift $ toForm (Just x)
+  let pathText = toText $ renderPath path param
+  form_ [method_ "POST", action_ pathText] $ do
+    forM_ form snd
+    input_ [type_ "submit"]
+
+-- instance (ToHtml c) => GToEditForm (K1 i c) where
+--   gToEditForm (K1 x) = do
+--     td_ (toHtml x)
+
+-- instance (GToEditForm f) => GToEditForm (M1 i t f) where
+--   gToEditForm (M1 x) = do
+--     gToEditForm x
+
+
+-- todo: create router library, and refactor listPath andcreatePath, etc.
diff --git a/src/TypedAdmin/Router.hs b/src/TypedAdmin/Router.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin/Router.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE TypeOperators         #-}
+
+module TypedAdmin.Router where
+
+import           Control.Monad
+import           Data.String
+import           Data.Text        (Text, intercalate, pack)
+import           Data.Typeable    (Typeable)
+import           TypedAdmin.Class
+import           Web.HttpApiData
+
+class PathParam a b where
+  fromPath :: a -> [Text] -> Maybe b
+  renderPath :: a -> b -> [Text]
+
+instance PathParam (Path a) () where
+  fromPath x y = f (Just Nothing) x y
+    where
+      f :: Maybe (Maybe ()) -> (Path b) -> [Text] -> Maybe ()
+      f Nothing _ _ = Nothing
+      f a EmptyP [] = join a
+      f _ (StaticP p1 ps) (x:xs)
+        | p1 == x = f (Just $ Just ()) ps xs
+        | otherwise = Nothing
+      f _ _ _ = Nothing
+  renderPath path _ = f [] path
+    where
+      f :: [Text] -> (Path a) -> [Text]
+      f xs EmptyP          = xs
+      f xs (StaticP p1 ps) = f (p1:xs) ps
+
+toText = ("/" <>) . intercalate "/"
+
+instance (FromHttpApiData a, ToHttpApiData a) => PathParam (Path '[a]) a where
+  fromPath x y = f (Just Nothing) x y
+    where
+      f :: Maybe (Maybe a) -> (Path b) -> [Text] -> Maybe a
+      f Nothing _ _ = Nothing
+      f a EmptyP [] = join a
+      f a (StaticP p1 ps) (x:xs)
+        | p1 == x = f a ps xs
+        | otherwise = Nothing
+      f (Just Nothing) (VarP ps) (x:xs) = f (Just $ parseUrlPieceMaybe x) ps xs
+      f _ _ _ = Nothing
+  renderPath path x = f [] path
+    where
+      f :: [Text] -> (Path b) -> [Text]
+      f xs EmptyP          = xs
+      f xs (StaticP p1 ps) = f (p1:xs) ps
+      f xs (VarP ps)       = f (toUrlPiece x:xs) ps
+
+data Route m where
+  ListR :: (ListConsole m a b) => Path c -> p1 a -> p2 b -> Route m
+  DetailR :: (DetailConsole m a, PathParam (Path c) (Ident a)) => Path c -> p1 a -> Route m
+  CreateR :: CreateConsole m a b => Path c -> p1 a -> p2 b -> Route m
+  EditR :: (EditConsole m a b, PathParam (Path c) (EditIdent a b)) => Path c -> p1 a -> p2 b -> Route m
+  DeleteR :: (DeleteConsole m a, PathParam (Path c) (DeleteIdent a)) => Path c -> p1 a -> Route m
+
+instance a ~ '[] => IsString (Path a) where
+  fromString x = StaticP (pack x) EmptyP
+
+instance a ~ '[] => IsString (Path a -> Path a) where
+  fromString x = StaticP (pack x)
+
+data Path (as :: [*]) where
+  EmptyP :: Path '[]
+  StaticP :: Text -> Path as -> Path as
+  VarP :: (FromHttpApiData a, Typeable a) => Path as -> Path (a ': as)
+deriving instance Show (Path i)
+
+static = StaticP
+
+var :: (FromHttpApiData a, Typeable a) => Path as -> Path (a : as)
+var = VarP
+
+(</>) :: Path as -> (Path as -> Path bs) -> Path bs
+(</>) x y = y x
diff --git a/src/TypedAdmin/Util.hs b/src/TypedAdmin/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/TypedAdmin/Util.hs
@@ -0,0 +1,20 @@
+module TypedAdmin.Util where
+
+import           Control.Monad
+import qualified Data.ByteString.UTF8 as BS
+import           Data.Maybe
+import           Text.Read
+
+lookupMaybe k ps = readMaybe =<< BS.toString <$> join (lookup k ps)
+
+whenJust (Just x) f = f x
+whenJust _ _        = return ()
+
+mapSnd f (x, y) = (x, f y)
+
+memptyToNothing :: (Eq a, Monoid a) => a -> Maybe a
+memptyToNothing x = if x == mempty then Nothing else Just x
+
+
+firstJust :: (a -> Maybe b) -> [a] -> Maybe b
+firstJust f = listToMaybe . mapMaybe f
diff --git a/templates/javascript/map.js b/templates/javascript/map.js
new file mode 100644
--- /dev/null
+++ b/templates/javascript/map.js
@@ -0,0 +1,24 @@
+var map;
+function initMap() {
+  var textLocationLat = document.getElementById("locationLat")
+  var textLocationLon = document.getElementById("locationLon")
+  var initialLocation = {lat: parseFloat(textLocationLat.value),
+                         lng: parseFloat(textLocationLon.value)}
+  map = new google.maps.Map(document.getElementById('map'), {
+    center: initialLocation,
+    zoom: 8
+  });
+  google.maps.event.addListener(map, 'click', function(event) {
+    placeMarker(event.latLng);
+  });
+  var marker = new google.maps.Marker({
+    position: initialLocation,
+    map: map
+  });
+  function placeMarker(location) {
+    console.log('location', location)
+    marker.setPosition(location)
+    textLocationLat.value = location.lat()
+    textLocationLon.value = location.lng()
+  }
+}
diff --git a/typed-admin.cabal b/typed-admin.cabal
new file mode 100644
--- /dev/null
+++ b/typed-admin.cabal
@@ -0,0 +1,127 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.1.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: d279f498e01236e4eeba599e54ec192a01d94bd39d0bf497afafcc0a6d3d4362
+
+name:           typed-admin
+version:        0.1.0.0
+synopsis:       Admin console framework
+description:    Please see the README on GitHub at <https://github.com/nakaji-dayo/typed-admin#readme>
+category:       Web
+homepage:       https://github.com/nakaji-dayo/typed-admin#readme
+bug-reports:    https://github.com/nakaji-dayo/typed-admin/issues
+author:         Daishi Nakajima
+maintainer:     nakaji.dayo@gmail.com
+copyright:      2018 Daishi Nakajima
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+    templates/javascript/map.js
+
+source-repository head
+  type: git
+  location: https://github.com/nakaji-dayo/typed-admin
+
+flag example
+  description: build example
+  manual: True
+  default: False
+
+library
+  exposed-modules:
+      TypedAdmin
+      TypedAdmin.Class
+      TypedAdmin.Extra
+      TypedAdmin.Instance
+      TypedAdmin.Router
+      TypedAdmin.Util
+  other-modules:
+      Paths_typed_admin
+  hs-source-dirs:
+      src
+  build-depends:
+      HDBC
+    , HDBC-postgresql
+    , HDBC-session
+    , base >=4.7 && <5
+    , blaze-markup
+    , bytestring
+    , data-default-class
+    , exceptions
+    , generic-lens >=1.1.0.0
+    , heterocephalus
+    , http-api-data
+    , http-types
+    , lucid
+    , monad-control
+    , mtl
+    , persistable-record
+    , relational-query
+    , relational-query-HDBC
+    , relational-record
+    , template-haskell
+    , text
+    , time
+    , transformers
+    , transformers-base
+    , unordered-containers
+    , utf8-string
+    , wai
+    , wai-extra
+    , warp
+    , yaml
+  default-language: Haskell2010
+
+executable typed-admin-exe
+  main-is: Main.hs
+  other-modules:
+      DataSource2
+      Entity.Beer
+      Entity.BeerImage
+      Entity.Store
+      Paths_typed_admin
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      HDBC
+    , HDBC-postgresql
+    , HDBC-session
+    , base >=4.7 && <5
+    , blaze-markup
+    , bytestring
+    , data-default-class
+    , exceptions
+    , generic-lens >=1.1.0.0
+    , heterocephalus
+    , http-api-data
+    , http-types
+    , lens
+    , lucid
+    , monad-control
+    , mtl
+    , persistable-record
+    , relational-query
+    , relational-query-HDBC
+    , relational-record
+    , template-haskell
+    , text
+    , time
+    , transformers
+    , transformers-base
+    , typed-admin
+    , unordered-containers
+    , utf8-string
+    , wai
+    , wai-extra
+    , warp
+    , yaml
+  if !(flag(example))
+    buildable: False
+  default-language: Haskell2010