gistfile1.hs

{-# LANGUAGE NoMonomorphismRestriction #-}

module Test where


-------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Control.Applicative
import           Control.Monad.Identity
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Either
import           Data.ByteString               (ByteString, writeFile)
import qualified Data.ByteString.Lazy          as BS
import           Data.Monoid
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import           Data.Text.Encoding            (encodeUtf8)
import qualified Data.Text.Lazy                as LT
import           Heist
import           Heist.Interpreted
import           Prelude                       hiding (writeFile)
import           Snap.Extras.FormUtils
import           System.FilePath               ((</>))
import           Text.Blaze.Html.Renderer.Text (renderHtml)
import           Text.Digestive
import           Text.Digestive.Form.Internal
import           Text.Digestive.Heist
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
writeTestFile :: String -> IO ByteString -> IO ()
writeTestFile fname bs =
    bs >>= writeFile ("test-templates" </> fname)


render :: Splices (Splice IO) -> ByteString -> IO ByteString
render splices templateName = do
    let hc = mempty{hcTemplateLocations=[templateLocation], hcInterpretedSplices=splices}
    ret <- runEitherT $ initHeist hc
    case ret of
      Left errs -> error (show errs)
      Right st -> do
        ret' <- renderTemplate st templateName
        case ret' of
          Nothing -> error "can't render template for some reason"
          Just (builder, _) -> return $ BS.toStrict $ toLazyByteString builder
  where
    templateLocation :: EitherT [String] IO TemplateRepo
    templateLocation = loadTemplates "test-templates"
-------------------------------------------------------------------------------


data Choice = C1 | C2 | C3 deriving (Show, Eq)

data GroupedChoice = GC1 | GC2 | GC3 deriving (Show, Eq)

data User = User
    { username          :: Text
    , email             :: Text
    , password          :: Text
    , urls              :: [Text]
    , isAdmin           :: Bool
    , someChoices       :: [Choice]
    , someGroupedChoice :: GroupedChoice
    } deriving (Show, Eq)


listForm :: Monad m => Form Text m [Text]
listForm = transform t (optionalText Nothing)
  where
    t :: Monad m => Maybe Text -> m (Result Text [Text])
    t (Just s) = return . Success . fmap T.strip . T.split (== ',') $ s
    t Nothing = return $ Error "can't parse list"


testForm :: Monad m => Form Text m User
testForm = User
    <$> "username" .: text Nothing
    <*> "email" .: text Nothing
    <*> "password" .: text Nothing
    <*> "urls" .: listForm
    <*> "isAdmin" .: bool Nothing
    <*> "someChoice" .: listOf (choice [(C1, "C1"), (C2, "C2"), (C3, "C3")]) Nothing
    <*> "someGroupedChoice" .: groupedChoice' [("??", [(GC1, "GC1")])] Nothing


test1 :: IO ByteString
test1 = (encodeUtf8 . LT.toStrict . renderHtml)
           <$> dfHeistTemplate "myForm" testForm


test1Splices :: MonadIO m => Splices (Splice m)
test1Splices = digestiveSplices $ runIdentity $ getForm "testForm" testForm


writeTest1Template :: IO ()
writeTest1Template = writeTestFile "test1.tpl" test1


renderTest1Template :: IO ByteString
renderTest1Template = render test1Splices "test1"