improved the geolite city type

colonnade/src/Colonnade/Types.hs

@@ -105,6 +105,7 @@ instance Applicative (Decoding f content) where
   DecodingPure f <*> y = fmap f y
   DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z)
 
+-- | Encodes a header and a cell.
 data OneEncoding f content a = OneEncoding
   { oneEncodingHead   :: !(f content)
   , oneEncodingEncode :: !(a -> content)

geolite-csv/src/Geolite/Csv.hs

@@ -33,6 +33,7 @@ decodingCity = City
   <*> CD.headed "subdivision_1_name" CDT.text
   <*> CD.headed "subdivision_2_iso_code" CDT.text
   <*> CD.headed "subdivision_2_name" CDT.text
+  <*> CD.headed "city_name" CDT.text
   <*> CD.headed "metro_code" (CDT.optional CDT.int)
   <*> CD.headed "time_zone" CDT.text
 

geolite-csv/src/Geolite/Types.hs

@@ -23,6 +23,7 @@ data City = City
   , citySubdivision1Name :: Text
   , citySubdivision2IsoCode :: Text
   , citySubdivision2Name :: Text
+  , cityName :: Text
   , cityMetroCode :: Maybe Int
   , cityTimeZone :: Text
   } deriving (Show,Read,Eq,Ord)

reflex-dom-colonnade/hackage-docs.sh

@@ -0,0 +1,48 @@
+#!/bin/bash
+set -e
+
+if [ "$#" -ne 1 ]; then
+  echo "Usage: scripts/hackage-docs.sh HACKAGE_USER"
+  exit 1
+fi
+
+user=$1
+
+cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit)
+if [ ! -f "$cabal_file" ]; then
+  echo "Run this script in the top-level package directory"
+  exit 1
+fi
+
+pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name"    { print $2 }' < "$cabal_file")
+ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file")
+
+if [ -z "$pkg" ]; then
+  echo "Unable to determine package name"
+  exit 1
+fi
+
+if [ -z "$ver" ]; then
+  echo "Unable to determine package version"
+  exit 1
+fi
+
+echo "Detected package: $pkg-$ver"
+
+dir=$(mktemp -d build-docs.XXXXXX)
+trap 'rm -r "$dir"' EXIT
+
+# cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version'
+stack haddock
+
+cp -R .stack-work/dist/x86_64-linux/Cabal-1.22.5.0/doc/html/$pkg/ $dir/$pkg-$ver-docs
+# /home/andrew/.stack/snapshots/x86_64-linux/lts-5.17/7.10.3/doc/index.html
+
+tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs
+
+curl -X PUT \
+     -H 'Content-Type: application/x-tar' \
+     -H 'Content-Encoding: gzip' \
+     -u "$user" \
+     --data-binary "@$dir/$pkg-$ver-docs.tar.gz" \
+     "https://hackage.haskell.org/package/$pkg-$ver/docs"

reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs

@@ -1,6 +1,12 @@
 {-# LANGUAGE DeriveFunctor #-}
 
-module Reflex.Dom.Colonnade where
+module Reflex.Dom.Colonnade
+  ( Cell(..)
+  , cell
+  , basic
+  , dynamic
+  , dynamicEventful
+  ) where
 
 import Colonnade.Types
 import Control.Monad
@@ -17,14 +23,16 @@ import qualified Data.Map as Map
 cell :: m b -> Cell m b
 cell = Cell Map.empty
 
+-- data NewCell b = NewCell
+--   { newCellAttrs :: !(Map String String)
+--   , newCellContents :: !b
+--   } deriving (Functor)
+
 data Cell m b = Cell
   { cellAttrs :: !(Map String String)
   , cellContents :: !(m b)
   } deriving (Functor)
 
--- instance Functor (Cell m) where
---   fmap f (a
-
 basic :: (MonadWidget t m, Foldable f)
       => Map String String -- ^ Table element attributes
       -> f a -- ^ Values
@@ -50,16 +58,16 @@ dynamic :: (MonadWidget t m, Foldable f)
         -> m ()
 dynamic tableAttrs as encoding@(Encoding v) = do
   elAttr "table" tableAttrs $ do
-    theadBuild encoding
+    b1 <- theadBuild encoding
-    el "tbody" $ forM_ as $ \a -> do
+    b2 <- el "tbody" $ forM_ as $ \a -> do
       el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do
         dynPair <- mapDyn encode a
         dynAttrs <- mapDyn cellAttrs dynPair
         dynContent <- mapDyn cellContents dynPair
-        _ <- elDynAttr "td" dynAttrs $ dyn dynContent
+        elDynAttr "td" dynAttrs $ dyn dynContent
-        return ()
+    return (mappend b1 b2)
 
-dynamicEventful :: (MonadWidget t m, Traversable f, Semigroup e)
+dynamicEventful :: (MonadWidget t m, Foldable f, Semigroup e)
   => Map String String -- ^ Table element attributes
   -> f (Dynamic t a) -- ^ Dynamic values
   -> Encoding Headed (Cell m (Event t e)) a -- ^ Encoding of a value into cells
@@ -67,13 +75,57 @@ dynamicEventful :: (MonadWidget t m, Traversable f, Semigroup e)
 dynamicEventful tableAttrs as encoding@(Encoding v) = do
   elAttr "table" tableAttrs $ do
     b1 <- theadBuild encoding
-    b2 <- el "tbody" $ forM as $ \a -> do
+    b2 <- el "tbody" $ flip foldMapM as $ \a -> do
-      el "tr" $ forM v $ \(OneEncoding _ encode) -> do
+      el "tr" $ flip foldMapM v $ \(OneEncoding _ encode) -> do
         dynPair <- mapDyn encode a
         dynAttrs <- mapDyn cellAttrs dynPair
         dynContent <- mapDyn cellContents dynPair
         e <- elDynAttr "td" dynAttrs $ dyn dynContent
         -- TODO: This might actually be wrong. Revisit this.
         switchPromptly never e
-    return (mappend b1 (mconcat $ toList $ mconcat $ toList b2))
+    return (mappend b1 b2)
+
+foldMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
+foldMapM f = foldrM (\a b -> fmap (flip mappend b) (f a)) mempty
+
+foldAlternativeM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
+foldAlternativeM f = foldrM (\a b -> fmap (flip mappend b) (f a)) mempty
+
+-- dynamicEventfulWith :: (MonadWidget t m, Foldable f, Semigroup e, Monoid b)
+--   => (e -> b)
+--   -> Map String String -- ^ Table element attributes
+--   -> f (Dynamic t a) -- ^ Dynamic values
+--   -> Encoding Headed (Cell m (Event t e)) a -- ^ Encoding of a value into cells
+--   -> m (Event t e)
+-- dynamicEventfulWith f tableAttrs as encoding@(Encoding v) = do
+--   elAttr "table" tableAttrs $ do
+--     b1 <- theadBuild encoding
+--     b2 <- el "tbody" $ flip foldMapM as $ \a -> do
+--       el "tr" $ flip foldMapM v $ \(OneEncoding _ encode) -> do
+--         dynPair <- mapDyn encode a
+--         dynAttrs <- mapDyn cellAttrs dynPair
+--         dynContent <- mapDyn cellContents dynPair
+--         e <- elDynAttr "td" dynAttrs $ dyn dynContent
+--         flattenedEvent <- switchPromptly never e
+--         return (f flattenedEvent)
+--     return (mappend b1 b2)
+--
+-- dynamicEventfulMany :: (MonadWidget t m, Foldable f, Alternative g)
+--   => Map String String -- ^ Table element attributes
+--   -> f (Dynamic t a) -- ^ Dynamic values
+--   -> Encoding Headed (NewCell (g (Compose m (Event t)))) a -- ^ Encoding of a value into cells
+--   -> m (g (Event t e))
+-- dynamicEventfulMany tableAttrs as encoding@(Encoding v) = do
+--   elAttr "table" tableAttrs $ do
+--     -- b1 <- theadBuild encoding
+--     b2 <- el "tbody" $ flip foldMapM as $ \a -> do
+--       el "tr" $ flip foldMapM v $ \(OneEncoding _ encode) -> do
+--         dynPair <- mapDyn encode a
+--         dynAttrs <- mapDyn cellAttrs dynPair
+--         dynContent <- mapDyn cellContents dynPair
+--         e <- elDynAttr "td" dynAttrs $ dyn dynContent
+--         switchPromptly never e
+--     return (mappend b1 b2)
+
+-- data Update f = UpdateName (f Text) | UpdateAge (f Int) | ...