takahashi 0.2.0.2 → 0.2.1.0

raw patch · 10 files changed

+481/−472 lines, 10 filesdep +lensdep +monad-skeletondep −reasonable-lensdep −reasonable-operationaldep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: lens, monad-skeleton

Dependencies removed: reasonable-lens, reasonable-operational

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• html/Temp.html +14/−2
• src/Control/Monad/Takahashi.hs +6/−279
• src/Control/Monad/Takahashi/API.hs +341/−0
• src/Control/Monad/Takahashi/HtmlBuilder.hs +3/−1
• src/Control/Monad/Takahashi/HtmlBuilder/Monad.hs +13/−13
• src/Control/Monad/Takahashi/HtmlBuilder/Style.hs +2/−2
• src/Control/Monad/Takahashi/Monad.hs +79/−13
• src/Control/Monad/Takahashi/Slide.hs +4/−153
• src/Control/Monad/Takahashi/Util.hs +9/−0
• takahashi.cabal +10/−9

@@ -25,9 +25,21 @@     }      document.onkeydown = function(e){-      if(e.keyCode == 39) changeSlide(SlideIndex + 1);-      if(e.keyCode == 37) changeSlide(SlideIndex - 1);+      if(e.keyCode == 39 || e.keyCode == 34) changeSlide(SlideIndex + 1);+      if(e.keyCode == 37 || e.keyCode == 33) changeSlide(SlideIndex - 1);     }++    // -----++    function judgeMoveSlide(x){+      if(x > (window.innerWidth / 3 * 2)) changeSlide(SlideIndex + 1);+      if(x < (window.innerWidth / 3)) changeSlide(SlideIndex - 1);+    }++    document.ontouchend = function(e){+      judgeMoveSlide(e.changedTouches[0].pageX);+    }+   </script>   <style>     html, body {

@@ -1,291 +1,18 @@ {-# LANGUAGE GADTs, ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} module Control.Monad.Takahashi -  ( module Control.Monad.Takahashi.Monad-  , takaCont-  , parCont-  , listCont-  , takaCont2-  , parCont2-  , listCont2-  , horizonCont-  , verticalCont-  , annotationCont-  , imgCont-  , codeCont-  , titleCont-  , twinTopCont-  , twinBottomCont-  , twinLeftCont-  , twinRightCont-  -----  , title-  , taka-  , par-  , list-  , taka2-  , par2-  , list2-  , horizon-  , vertical-  , annotation-  , img-  , code-  , code2-  , twinTop-  , twinBottom-  , twinLeft-  , twinRight-  -----  , makePage-  -------  -- from Control.Monad.Takahashi.Slide-  , BlockOption-  , fontColor, bgColor, frameColor, frameStyle-  , SlideOption-  , slideTitle, slideFontSize, titleOption, codeOption-  , contentsOption, contentsOption2, annotationOption, blockFontSize-  , defaultSlideOption-  -----  , Taka(..) -  , buildTakahashi-  , writeSlide-  -----  , runTakahashi-  , showTakahashi-  , makeSlide -  -----  , contents-  , central-  -----  , Contents-  , bindPage-  -------  -- from Control.Monad.Takahashi.HtmlBuilder-  , Color(..)-  , DrawType(..)-  , BorderStyle(..)-  -------  -- from Control.Monad.Takahashi.Util-  , stateSandbox+  ( module Control.Monad.Takahashi.API+  , module Control.Monad.Takahashi.Slide+  , module Control.Monad.Takahashi.Monad+  , module Control.Monad.Takahashi.HtmlBuilder+  , module Control.Monad.Takahashi.Util   ) where import Control.Lens import Control.Monad.State +import Control.Monad.Takahashi.API import Control.Monad.Takahashi.Slide import Control.Monad.Takahashi.Monad import Control.Monad.Takahashi.HtmlBuilder import Control.Monad.Takahashi.Util -------- Contents--takaCont :: String -> Contents-takaCont = takaContBase makeContentsStyle--listCont :: [String] -> Contents-listCont = listContBase basicContents--parCont :: String -> Contents-parCont = parContBase basicContents--takaCont2 :: String -> Contents-takaCont2 = takaContBase makeContentsStyle2--listCont2 :: [String] -> Contents-listCont2 = listContBase basicContents2--parCont2 :: String -> Contents-parCont2 = parContBase basicContents2--imgCont :: DrawType -> String -> Contents-imgCont dt fp = Contents $-  \option -> central (return ()) $ drawPicture dt fp--codeCont :: String -> Contents-codeCont s = Contents $-  \option -> contents (codeContents option) $ writeParagraph s--------horizonCont :: [Contents] -> Contents-horizonCont cs = Contents $ -  \option -> horizonDiv . map (contents2DivInfo option) $ cs--verticalCont :: [Contents] -> Contents-verticalCont cs = Contents $-  \option -> verticalDiv . map (contents2DivInfo option) $ cs-    -annotationCont :: Contents -> String -> Contents-annotationCont p s = Contents $ \option -> do-    verticalDiv-      [ divInfo-          { divRatio = 11-          , divData = do-              display .= Just Table-              extructHBuilder p option-          }-      , divInfo-          { divData = do-              writeParagraph s-          , divMakeStyle = do-              display .= Just Table-              makeAnnotationStyle option-          }-      ]--twinTopCont :: Contents -> Contents -> Contents-twinTopCont c1 c2 = makeTwinCont verticalDiv 2 1 c1 c2--twinBottomCont :: Contents -> Contents -> Contents-twinBottomCont c1 c2 = makeTwinCont verticalDiv 1 2 c1 c2--twinLeftCont :: Contents -> Contents -> Contents-twinLeftCont c1 c2 = makeTwinCont horizonDiv 2 1 c1 c2--twinRightCont :: Contents -> Contents -> Contents-twinRightCont c1 c2 = makeTwinCont horizonDiv 2 1 c1 c2--titleCont :: String -> String -> Contents-titleCont t s = Contents $ -  \option -> central (makeTitleStyle option) $ do-    writeHeader1 t-    writeParagraph s-------subTitlePage :: String -> Contents -> Contents-subTitlePage s p = Contents $ \option -> do-  verticalDiv-    [ divInfo-      { divRatio = 10 -      , divData = do-          central (return ()) $ writeHeader2 s-      , divMakeStyle = do-          display .= Just Table-          makeTitleStyle option-      }-    , divInfo-      { divRatio = 45 -      , divData = extructHBuilder p option-      , divMakeStyle = display .= Just Table-      }-    ]--takaContBase :: (SlideOption -> MakeStyle ()) -> String -> Contents-takaContBase m s = Contents $ -  \option -> central (m option) $ writeHeader1 s--listContBase :: (SlideOption -> MakeStyle ()) -> [String] -> Contents-listContBase m xs = Contents $ -  \option -> contents (m option) $ writeList xs--parContBase :: (SlideOption -> MakeStyle ()) -> String -> Contents-parContBase m s = Contents $ -  \option -> contents (m option) $ writeParagraph s--------- slides--title :: String -> String -> Taka ()-title t s = get >>= slide . extructHBuilder (titleCont t s)--taka :: String -> Taka ()-taka s = makePage $ takaCont s--list :: [String] -> Taka ()-list xs = makePage $ listCont xs--par :: String -> Taka ()-par s = makePage $ parCont s--taka2 :: String -> Taka ()-taka2 s = makePage $ takaCont2 s--list2 :: [String] -> Taka ()-list2 xs = makePage $ listCont2 xs--par2 :: String -> Taka ()-par2 s = makePage $ parCont2 s--horizon :: [Contents] -> Taka ()-horizon ps = makePage $ horizonCont ps--vertical :: [Contents] -> Taka ()-vertical ps = makePage $ verticalCont ps--annotation :: Contents -> String -> Taka ()-annotation p s = makePage $ annotationCont p s--img :: DrawType -> String -> Taka ()-img dt s = makePage $ imgCont dt s--code :: String -> String -> Taka ()-code s c = twinBottom (parCont s) (codeCont c)--code2 :: String -> String -> Taka ()-code2 s c = twinBottom (parCont2 s) (codeCont c)--twinTop :: Contents -> Contents -> Taka ()-twinTop c1 c2 = makePage $ twinTopCont c1 c2--twinBottom :: Contents -> Contents -> Taka ()-twinBottom c1 c2 = makePage $ twinBottomCont c1 c2--twinLeft :: Contents -> Contents -> Taka ()-twinLeft c1 c2 = makePage $ twinLeftCont c1 c2--twinRight :: Contents -> Contents -> Taka ()-twinRight c1 c2 = makePage $ twinRightCont c1 c2--------- helper--makePage :: Contents -> Taka ()-makePage p = do-  s <- use slideTitle-  case s of-    "" -> bindPage p-    _  -> bindPage (subTitlePage s p)--------contents2DivInfo :: SlideOption -> Contents -> DivInfo Style-contents2DivInfo o f = divInfo { divData = extructHBuilder f o }--basicContents :: SlideOption -> MakeStyle ()-basicContents o = do-  makeContentsStyle o-  setPadding--basicContents2 :: SlideOption -> MakeStyle ()-basicContents2 o = do-  makeContentsStyle2 o-  setPadding--codeContents :: SlideOption -> MakeStyle ()-codeContents o = do-  makeCodeStyle o-  margin.paddingLeft .= Just (Per 8)--setPadding :: MakeStyle ()-setPadding = do-  margin.paddingTop .= Just (Per 3)-  margin.paddingLeft .= Just (Per 8)--makeTwinCont :: ([DivInfo Style] -> HBuilder ()) -  -> Int -> Int -> Contents -> Contents -> Contents-makeTwinCont builder i1 i2 c1 c2 = Contents $ \option -> do-  builder-    [ divInfo-        { divRatio = i1-        , divData = do-            display .= Just Table-            extructHBuilder c1 option-        }-    , divInfo-        { divRatio = i2-        , divData = do-            display .= Just Table-            extructHBuilder c2 option-        }-    ]

@@ -0,0 +1,341 @@+{-# LANGUAGE RankNTypes #-}+module Control.Monad.Takahashi.API +  ( Contents(..)+  , bindPage+  ----+  , takaCont +  , listCont +  , parCont +  , takaCont2 +  , listCont2 +  , parCont2 +  , imgCont +  , codeCont +  , horizonCont +  , verticalCont +  , annotationCont +  , twinTopCont +  , twinBottomCont +  , twinLeftCont +  , twinRightCont +  , titleCont +  ----+  , title +  , taka +  , list +  , par +  , taka2 +  , list2 +  , par2 +  , horizon +  , vertical +  , annotation +  , img +  , code +  , code2 +  , twinTop +  , twinBottom +  , twinLeft +  , twinRight +  ) where+import Control.Monad.State+import Control.Lens++import Control.Monad.Takahashi.Monad+import Control.Monad.Takahashi.HtmlBuilder+import Control.Monad.Takahashi.Util++----++newtype Contents = Contents { extructHBuilder :: SlideOption -> HBuilder () }++bindPage :: Contents -> Taka ()+bindPage p = do+  o <- get+  slide . extructHBuilder p $ o++----+-- Contents++takaCont :: String -> Contents+takaCont = takaContBase makeContentsStyle++listCont :: [String] -> Contents+listCont = listContBase basicContents++parCont :: String -> Contents+parCont = parContBase basicContents++takaCont2 :: String -> Contents+takaCont2 = takaContBase makeContentsStyle2++listCont2 :: [String] -> Contents+listCont2 = listContBase basicContents2++parCont2 :: String -> Contents+parCont2 = parContBase basicContents2++imgCont :: DrawType -> String -> Contents+imgCont dt fp = Contents $+  \option -> central (return ()) $ drawPicture dt fp++codeCont :: String -> Contents+codeCont s = Contents $+  \option -> contents (codeContents option) $ writeParagraph s++----++horizonCont :: [Contents] -> Contents+horizonCont cs = Contents $ +  \option -> horizonDiv . map (contents2DivInfo option) $ cs++verticalCont :: [Contents] -> Contents+verticalCont cs = Contents $+  \option -> verticalDiv . map (contents2DivInfo option) $ cs+    +annotationCont :: Contents -> String -> Contents+annotationCont p s = Contents $ \option -> do+    verticalDiv+      [ divInfo+          { divRatio = 11+          , divData = do+              display .= Just Table+              extructHBuilder p option+          }+      , divInfo+          { divData = do+              writeParagraph s+          , divMakeStyle = do+              display .= Just Table+              makeAnnotationStyle option+          }+      ]++twinTopCont :: Contents -> Contents -> Contents+twinTopCont c1 c2 = makeTwinCont verticalDiv 2 1 c1 c2++twinBottomCont :: Contents -> Contents -> Contents+twinBottomCont c1 c2 = makeTwinCont verticalDiv 1 2 c1 c2++twinLeftCont :: Contents -> Contents -> Contents+twinLeftCont c1 c2 = makeTwinCont horizonDiv 2 1 c1 c2++twinRightCont :: Contents -> Contents -> Contents+twinRightCont c1 c2 = makeTwinCont horizonDiv 2 1 c1 c2++titleCont :: String -> String -> Contents+titleCont t s = Contents $ +  \option -> central (makeTitleStyle option) $ do+    writeHeader1 t+    writeParagraph s++----++subTitlePage :: String -> Contents -> Contents+subTitlePage s p = Contents $ \option -> do+  verticalDiv+    [ divInfo+      { divRatio = 10 +      , divData = do+          central (return ()) $ writeHeader2 s+      , divMakeStyle = do+          display .= Just Table+          makeTitleStyle option+      }+    , divInfo+      { divRatio = 45 +      , divData = extructHBuilder p option+      , divMakeStyle = display .= Just Table+      }+    ]++takaContBase :: (SlideOption -> MakeStyle ()) -> String -> Contents+takaContBase m s = Contents $ +  \option -> central (m option) $ writeHeader1 s++listContBase :: (SlideOption -> MakeStyle ()) -> [String] -> Contents+listContBase m xs = Contents $ +  \option -> contents (m option) $ writeList xs++parContBase :: (SlideOption -> MakeStyle ()) -> String -> Contents+parContBase m s = Contents $ +  \option -> contents (m option) $ writeParagraph s++----+-- slides++title :: String -> String -> Taka ()+title t s = get >>= slide . extructHBuilder (titleCont t s)++taka :: String -> Taka ()+taka s = makePage $ takaCont s++list :: [String] -> Taka ()+list xs = makePage $ listCont xs++par :: String -> Taka ()+par s = makePage $ parCont s++taka2 :: String -> Taka ()+taka2 s = makePage $ takaCont2 s++list2 :: [String] -> Taka ()+list2 xs = makePage $ listCont2 xs++par2 :: String -> Taka ()+par2 s = makePage $ parCont2 s++horizon :: [Contents] -> Taka ()+horizon ps = makePage $ horizonCont ps++vertical :: [Contents] -> Taka ()+vertical ps = makePage $ verticalCont ps++annotation :: Contents -> String -> Taka ()+annotation p s = makePage $ annotationCont p s++img :: DrawType -> String -> Taka ()+img dt s = makePage $ imgCont dt s++code :: String -> String -> Taka ()+code s c = twinBottom (parCont s) (codeCont c)++code2 :: String -> String -> Taka ()+code2 s c = twinBottom (parCont2 s) (codeCont c)++twinTop :: Contents -> Contents -> Taka ()+twinTop c1 c2 = makePage $ twinTopCont c1 c2++twinBottom :: Contents -> Contents -> Taka ()+twinBottom c1 c2 = makePage $ twinBottomCont c1 c2++twinLeft :: Contents -> Contents -> Taka ()+twinLeft c1 c2 = makePage $ twinLeftCont c1 c2++twinRight :: Contents -> Contents -> Taka ()+twinRight c1 c2 = makePage $ twinRightCont c1 c2++++------+-- helper ++makeTitleStyle :: SlideOption -> MakeStyle ()+makeTitleStyle = makeBlockStyle titleOption++makeContentsStyle :: SlideOption -> MakeStyle ()+makeContentsStyle = makeBlockStyle contentsOption++makeContentsStyle2 :: SlideOption -> MakeStyle ()+makeContentsStyle2 = makeBlockStyle contentsOption2++makeAnnotationStyle :: SlideOption -> MakeStyle ()+makeAnnotationStyle = makeBlockStyle annotationOption++makeCodeStyle :: SlideOption -> MakeStyle ()+makeCodeStyle o = do+  makeBlockStyle codeOption o+  align.verticalAlign .= Just AlignMiddle+  font.fontFamily .= Just +    [ FontName "Consolas"+    , FontName "Liberation Mono"+    , FontName "Menlo"+    , FontName "Courier"+    , Monospace+    ]+  font.whiteSpace .= Just Pre++makeBlockStyle :: Getter SlideOption BlockOption -> SlideOption -> MakeStyle ()+makeBlockStyle getter option = do+  border.borderStyle .= Just BorderSolid+  border.boxSizing .= Just BorderBox+  border.borderWidth .= Just 10++  border.borderColor .= option^.getter.frameColor+  font.foreColor .= option^.getter.fontColor+  font.fontSize .= option^.getter.blockFontSize+  border.borderStyle .= option^.getter.frameStyle+  backGround .= option^.getter.bgColor++----++contents :: MakeStyle () -> HBuilder () -> HBuilder ()+contents mStyle f = let+  innerDiv = do+      verticalDiv+        [ divInfo+          { divMakeStyle = do+              mStyle+              display .= Just TableCell+          , divData = f+          }+        ]+  in do+    verticalDiv+      [ divInfo+        { divMakeStyle = do+            display .= Just Table+        , divData = innerDiv+        }+      ]++central :: MakeStyle () -> HBuilder () -> HBuilder ()+central mStyle f = let+  newStyle = do+    mStyle+    align.textAlign .= Just AlignCenter+    align.verticalAlign .= Just AlignMiddle+  in contents newStyle f++----++makePage :: Contents -> Taka ()+makePage p = do+  s <- use slideTitle+  case s of+    "" -> bindPage p+    _  -> bindPage (subTitlePage s p)++----++contents2DivInfo :: SlideOption -> Contents -> DivInfo Style+contents2DivInfo o f = divInfo { divData = extructHBuilder f o }++basicContents :: SlideOption -> MakeStyle ()+basicContents o = do+  makeContentsStyle o+  setPadding++basicContents2 :: SlideOption -> MakeStyle ()+basicContents2 o = do+  makeContentsStyle2 o+  setPadding++codeContents :: SlideOption -> MakeStyle ()+codeContents o = do+  makeCodeStyle o+  margin.paddingLeft .= Just (Per 8)++setPadding :: MakeStyle ()+setPadding = do+  margin.paddingTop .= Just (Per 3)+  margin.paddingLeft .= Just (Per 8)++makeTwinCont :: ([DivInfo Style] -> HBuilder ()) +  -> Int -> Int -> Contents -> Contents -> Contents+makeTwinCont builder i1 i2 c1 c2 = Contents $ \option -> do+  builder+    [ divInfo+        { divRatio = i1+        , divData = do+            display .= Just Table+            extructHBuilder c1 option+        }+    , divInfo+        { divRatio = i2+        , divData = do+            display .= Just Table+            extructHBuilder c2 option+        }+    ]+

@@ -20,7 +20,7 @@  import Data.List import Data.Monoid-import Control.Monad.Operational+import Control.Monad.Skeleton import Control.Monad.RWS  ----@@ -96,3 +96,5 @@     drawType2MakeStyle Stretch = do       size.height .= Just (Per 90)       size.width .= Just (Per 90)++

@@ -2,7 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} module Control.Monad.Takahashi.HtmlBuilder.Monad where-import Control.Monad.Operational+import Control.Monad.Skeleton import Control.Monad.State.Class(MonadState(..)) import Control.Monad.Takahashi.HtmlBuilder.Style import Control.Monad.Writer@@ -37,7 +37,7 @@   HorizonDiv :: [DivInfo o] -> HtmlBuilderBase o ()   WriteHtml :: Html -> HtmlBuilderBase o () -type HtmlBuilder o = Program (HtmlBuilderBase o) +type HtmlBuilder o = Skeleton (HtmlBuilderBase o)   instance MonadState x (HtmlBuilder x) where   put = putHtmlOption@@ -54,34 +54,34 @@ ----  getHtmlOption :: HtmlBuilder o o-getHtmlOption = singleton GetHtmlOption+getHtmlOption = bone GetHtmlOption  putHtmlOption :: o -> HtmlBuilder o ()-putHtmlOption v = singleton $ PutHtmlOption v+putHtmlOption v = bone $ PutHtmlOption v  writeHeader1 :: String -> HtmlBuilder o ()-writeHeader1 s = singleton $ WriteHeader1 s+writeHeader1 s = bone $ WriteHeader1 s  writeHeader2 :: String -> HtmlBuilder o ()-writeHeader2 s = singleton $ WriteHeader2 s+writeHeader2 s = bone $ WriteHeader2 s  writeHeader3 :: String -> HtmlBuilder o ()-writeHeader3 s = singleton $ WriteHeader3 s+writeHeader3 s = bone $ WriteHeader3 s  writeParagraph :: String -> HtmlBuilder o ()-writeParagraph ss = singleton $ WriteParagraph ss+writeParagraph ss = bone $ WriteParagraph ss  writeList :: [String] -> HtmlBuilder o ()-writeList ss = singleton $ WriteList ss+writeList ss = bone $ WriteList ss  drawPicture :: DrawType -> String -> HtmlBuilder o ()-drawPicture t fp = singleton $ DrawPicture t fp+drawPicture t fp = bone $ DrawPicture t fp  verticalDiv :: [DivInfo o] -> HtmlBuilder o ()-verticalDiv xs = singleton $ VerticalDiv xs+verticalDiv xs = bone $ VerticalDiv xs  horizonDiv :: [DivInfo o] -> HtmlBuilder o ()-horizonDiv xs = singleton $ HorizonDiv xs+horizonDiv xs = bone $ HorizonDiv xs  writeHtml :: Html -> HtmlBuilder o ()-writeHtml h = singleton $ WriteHtml h+writeHtml h = bone $ WriteHtml h

@@ -48,7 +48,7 @@ data Color = Color Integer Integer Integer deriving (Show, Read, Eq, Ord) data BorderStyle = BorderNone | BorderSolid | BorderDouble deriving (Show, Read, Eq, Ord) data BoxSizing = ContentsBox | BorderBox  deriving (Show, Read, Eq, Ord)-data FontFamily = FontName String | Monospace | Selif | SensSelif deriving (Show, Read, Eq, Ord)+data FontFamily = FontName String | Monospace | Selif | SansSelif deriving (Show, Read, Eq, Ord) data WhiteSpace = Normal | Pre deriving (Show, Read, Eq, Ord)  data Margin = Margin @@ -202,7 +202,7 @@           FontName s -> "'" ++ s ++ "'"           Monospace -> "monospace"           Selif -> "selif"-          SensSelif -> "sens-selif"+          SansSelif -> "sans-selif"        showWhiteSpace x         = case x of

@@ -1,31 +1,97 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-} module Control.Monad.Takahashi.Monad where-import Control.Monad.Operational+import Control.Lens+import Control.Monad.Skeleton import Control.Monad.State.Class(MonadState(..))  import Control.Monad.Takahashi.HtmlBuilder -data TakahashiBase o a where-  GetSlideOption :: TakahashiBase o o-  PutSlideOption :: o -> TakahashiBase o ()-  Slide :: HtmlBuilder Style () -> TakahashiBase o ()+data TakahashiBase a where+  GetSlideOption :: TakahashiBase SlideOption+  PutSlideOption :: SlideOption -> TakahashiBase ()+  Slide :: HtmlBuilder Style () -> TakahashiBase () -type Takahashi o = Program (TakahashiBase o)+type Taka = Skeleton TakahashiBase -instance MonadState x (Takahashi x) where+instance MonadState SlideOption Taka where   put = putSlideOption   get = getSlideOption  ---- -getSlideOption :: Takahashi o o-getSlideOption = singleton GetSlideOption+getSlideOption :: Taka SlideOption+getSlideOption = bone GetSlideOption -putSlideOption :: o -> Takahashi o ()-putSlideOption v = singleton $ PutSlideOption v+putSlideOption :: SlideOption -> Taka ()+putSlideOption v = bone $ PutSlideOption v -slide :: HtmlBuilder Style () -> Takahashi o ()-slide f = singleton $ Slide f+slide :: HtmlBuilder Style () -> Taka ()+slide f = bone $ Slide f +------+-- slide options++data BlockOption = BlockOption+  { _fontColor :: Maybe Color+  , _bgColor :: Maybe Color+  , _frameColor :: Maybe Color+  , _frameStyle :: Maybe BorderStyle+  , _blockFontSize :: Maybe Int+  } deriving (Show, Read, Eq, Ord)++data SlideOption = SlideOption +  { _slideTitle :: String+  , _slideFontSize :: Maybe Int+  , _titleOption :: BlockOption+  , _contentsOption :: BlockOption+  , _contentsOption2 :: BlockOption+  , _annotationOption :: BlockOption+  , _codeOption :: BlockOption+  } deriving (Show, Read, Eq, Ord)++makeLenses ''BlockOption+makeLenses ''SlideOption++defaultSlideOption :: SlideOption+defaultSlideOption = SlideOption+  { _slideTitle = ""+  , _slideFontSize = Nothing+  , _titleOption = BlockOption+    { _fontColor = Just $ Color 0 0 80+    , _bgColor = Just $ Color 100 100 255+    , _frameColor = Just $ Color 0 0 80+    , _frameStyle = Just BorderSolid+    , _blockFontSize = Nothing+    }+  , _contentsOption = BlockOption+    { _fontColor = Just $ Color 0 0 80+    , _bgColor = Just $ Color 200 200 255+    , _frameColor = Just $ Color 255 255 255+    , _frameStyle = Just BorderSolid+    , _blockFontSize = Nothing+    }+  , _contentsOption2 = BlockOption+    { _fontColor = Just $ Color 80 0 0+    , _bgColor = Just $ Color 255 200 200 +    , _frameColor = Just $ Color 255 255 255+    , _frameStyle = Just BorderSolid+    , _blockFontSize = Nothing+    }+  , _annotationOption = BlockOption+    { _fontColor = Just $ Color 255 0 0+    , _bgColor = Nothing+    , _frameColor = Just $ Color 255 255 255+    , _frameStyle = Nothing+    , _blockFontSize = Nothing+    }+  , _codeOption = BlockOption+    { _fontColor = Just $ Color 0 0 80+    , _bgColor = Nothing+    , _frameColor = Just $ Color 0 0 80+    , _frameStyle = Just BorderDouble+    , _blockFontSize = Nothing+    }+  }

@@ -18,100 +18,25 @@   , showTakahashi   , makeSlideWithTemplate   , makeSlide -  , makeTitleStyle-  , makeContentsStyle-  , makeContentsStyle2-  , makeAnnotationStyle-  , makeCodeStyle-  -----  , contents-  , central-  -----  , Contents(..)-  , bindPage   ) where import Control.Lens import Control.Monad.RWS import Data.List-import Paths_takahashi+import Control.Monad.Skeleton+import Paths_takahashi   import Control.Monad.Takahashi.Monad import Control.Monad.Takahashi.HtmlBuilder import Control.Monad.Takahashi.Util-import Control.Monad.Operational -data BlockOption = BlockOption-  { _fontColor :: Maybe Color-  , _bgColor :: Maybe Color-  , _frameColor :: Maybe Color-  , _frameStyle :: Maybe BorderStyle-  , _blockFontSize :: Maybe Int-  } deriving (Show, Read, Eq, Ord)--data SlideOption = SlideOption -  { _slideTitle :: String-  , _slideFontSize :: Maybe Int-  , _titleOption :: BlockOption-  , _contentsOption :: BlockOption-  , _contentsOption2 :: BlockOption-  , _annotationOption :: BlockOption-  , _codeOption :: BlockOption-  } deriving (Show, Read, Eq, Ord)--makeLenses ''BlockOption-makeLenses ''SlideOption--defaultSlideOption :: SlideOption-defaultSlideOption = SlideOption-  { _slideTitle = ""-  , _slideFontSize = Nothing-  , _titleOption = BlockOption-    { _fontColor = Just $ Color 0 0 80-    , _bgColor = Just $ Color 100 100 255-    , _frameColor = Just $ Color 0 0 80-    , _frameStyle = Just BorderSolid-    , _blockFontSize = Nothing-    }-  , _contentsOption = BlockOption-    { _fontColor = Just $ Color 0 0 80-    , _bgColor = Just $ Color 200 200 255-    , _frameColor = Just $ Color 255 255 255-    , _frameStyle = Just BorderSolid-    , _blockFontSize = Nothing-    }-  , _contentsOption2 = BlockOption-    { _fontColor = Just $ Color 80 0 0-    , _bgColor = Just $ Color 255 200 200 -    , _frameColor = Just $ Color 255 255 255-    , _frameStyle = Just BorderSolid-    , _blockFontSize = Nothing-    }-  , _annotationOption = BlockOption-    { _fontColor = Just $ Color 255 0 0-    , _bgColor = Nothing-    , _frameColor = Just $ Color 255 255 255-    , _frameStyle = Nothing-    , _blockFontSize = Nothing-    }-  , _codeOption = BlockOption-    { _fontColor = Just $ Color 0 0 80-    , _bgColor = Nothing-    , _frameColor = Just $ Color 0 0 80-    , _frameStyle = Just BorderDouble-    , _blockFontSize = Nothing-    }-  }- type TakahashiRWS a = RWS () Html SlideOption a  ---- -type Taka a = Takahashi SlideOption a- buildTakahashi :: Taka a -> TakahashiRWS a buildTakahashi t = interpret advent t   where-    advent :: TakahashiBase SlideOption a -> TakahashiRWS a+    advent :: TakahashiBase a -> TakahashiRWS a     advent GetSlideOption = get     advent (PutSlideOption o) = put o     advent (Slide t) = do@@ -138,84 +63,10 @@   return $ sub "##Presentation" (showTakahashi t) instr  makeSlide :: Taka a -> IO String-makeSlide t = getDataFileName "html/Temp.html" >>= flip makeSlideWithTemplate t+makeSlide t = getDataFileName "html/Temp.html" >>= flip makeSlideWithTemplate t   writeSlideWithTemplate :: String -> String -> Taka a -> IO () writeSlideWithTemplate r w = makeSlideWithTemplate r >=> writeFile w  writeSlide :: String -> Taka a -> IO () writeSlide w = makeSlide >=> writeFile w----------- helper --makeTitleStyle :: SlideOption -> MakeStyle ()-makeTitleStyle = makeBlockStyle titleOption--makeContentsStyle :: SlideOption -> MakeStyle ()-makeContentsStyle = makeBlockStyle contentsOption--makeContentsStyle2 :: SlideOption -> MakeStyle ()-makeContentsStyle2 = makeBlockStyle contentsOption2--makeAnnotationStyle :: SlideOption -> MakeStyle ()-makeAnnotationStyle = makeBlockStyle annotationOption--makeCodeStyle :: SlideOption -> MakeStyle ()-makeCodeStyle o = do-  makeBlockStyle codeOption o-  align.verticalAlign .= Just AlignMiddle-  font.fontFamily .= Just [SensSelif, Monospace]-  font.whiteSpace .= Just Pre--makeBlockStyle :: Getter SlideOption BlockOption -> SlideOption -> MakeStyle ()-makeBlockStyle getter option = do-  border.borderStyle .= Just BorderSolid-  border.boxSizing .= Just BorderBox-  border.borderWidth .= Just 10--  border.borderColor .= option^.getter.frameColor-  font.foreColor .= option^.getter.fontColor-  font.fontSize .= option^.getter.blockFontSize-  border.borderStyle .= option^.getter.frameStyle-  backGround .= option^.getter.bgColor--------contents :: MakeStyle () -> HBuilder () -> HBuilder ()-contents mStyle f = let-  innerDiv = do-      verticalDiv-        [ divInfo-          { divMakeStyle = do-              mStyle-              display .= Just TableCell-          , divData = f-          }-        ]-  in do-    verticalDiv-      [ divInfo-        { divMakeStyle = do-            display .= Just Table-        , divData = innerDiv-        }-      ]--central :: MakeStyle () -> HBuilder () -> HBuilder ()-central mStyle f = let-  newStyle = do-    mStyle-    align.textAlign .= Just AlignCenter-    align.verticalAlign .= Just AlignMiddle-  in contents newStyle f--------newtype Contents = Contents { extructHBuilder :: SlideOption -> HBuilder () }--bindPage :: Contents -> Taka ()-bindPage p = do-  o <- get-  slide . extructHBuilder p $ o-

@@ -1,5 +1,8 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} module Control.Monad.Takahashi.Util where import Control.Monad.State+import Control.Monad.Skeleton import Data.List(isPrefixOf)  stateSandbox :: MonadState s m => m a -> m a@@ -15,3 +18,9 @@   | isPrefixOf x str = y ++ drop (length x) str   | otherwise = s:sub x y ss +interpret :: forall instr m b. Monad m => (forall a. instr a -> m a) -> Skeleton instr b -> m b+interpret f p = run $ unbone p+  where+    run :: MonadView instr (Skeleton instr) a -> m a+    run (Return x) = return x+    run (v :>>= n) = f v >>= run . unbone . n

@@ -2,9 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                takahashi-version:             0.2.0.2-synopsis:            Operational Monad implementation. It is more small but adequately.-description:         Just size Operational Monad implementation.+version:             0.2.1.0+description:         library for create slide for your presentation.+synopsis:            create slide for presentation. license:             MIT license-file:        LICENSE author:              tokiwoousaka@@ -23,10 +23,11 @@                        Control.Monad.Takahashi.HtmlBuilder,                         Control.Monad.Takahashi.Monad,                        Control.Monad.Takahashi.Slide,-                       Control.Monad.Takahashi.Util-  other-modules:       Paths_takahashi   -  build-depends:       base >=4.6 && <5, -                       reasonable-operational >=0.1, -                       mtl >=2.1,-                       reasonable-lens >=0.2.1+                       Control.Monad.Takahashi.Util,+                       Control.Monad.Takahashi.API+  other-modules:       Paths_takahashi+  build-depends:       base >=4.6 && <5 , +                       monad-skeleton,+                       lens,+                       mtl   hs-source-dirs:      src