haiji 0.1.0.1 → 0.2.0.0

raw patch · 4 files changed

+49/−96 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haiji.cabal +3/−3
• src/Text/Haiji.hs +1/−0
• src/Text/Haiji/Dictionary.hs +29/−91
• test/tests.hs +16/−2

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                haiji-version:             0.1.0.1+version:             0.2.0.0 synopsis:            A typed template engine, subset of jinja2 description:         Haiji is a template engine which is subset of jinja2.                      This is designed to free from the unintended rendering result@@ -56,7 +56,7 @@                      , doctest                      , filepath   hs-source-dirs:      test-  ghc-options:         -Wall -threaded -O0+  ghc-options:         -Wall -threaded   default-language:    Haskell2010  test-suite tests@@ -72,5 +72,5 @@                      , process-extras                      , data-default   hs-source-dirs:      test-  ghc-options:         -Wall -threaded -O0+  ghc-options:         -Wall -threaded   default-language:    Haskell2010

@@ -54,6 +54,7 @@     , autoEscape       -- * Dictionary     , Dict+    , toDict     , empty       -- ** Builder     , key

@@ -16,6 +16,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Text.Haiji.Dictionary        ( Dict(..)+       , toDict        , (:->)(..)        , empty        , singleton@@ -48,6 +49,10 @@ singleton :: x -> Key k -> Dict '[ k :-> x ] singleton x _ = Ext (Value x) Empty +-- | Create single element dictionary (with TypeApplications extention)+toDict :: forall k x . x -> Dict '[ k :-> x ]+toDict = flip singleton Key+ value :: k :-> v -> v value (Value v) = v @@ -57,15 +62,15 @@ class Retrieve d k v where   retrieve :: d -> Key k -> v #if MIN_VERSION_base(4,8,0)-instance {-# OVERLAPPABLE #-} (IsDict d, IsDict (kv ': d), Retrieve (Dict d) k v) => Retrieve (Dict (kv ': d)) k v where+instance {-# OVERLAPPABLE #-} Retrieve (Dict d) k v => Retrieve (Dict (kv ': d)) k v where #else-instance                      (IsDict d, IsDict (kv ': d), Retrieve (Dict d) k v) => Retrieve (Dict (kv ': d)) k v where+instance                      Retrieve (Dict d) k v => Retrieve (Dict (kv ': d)) k v where #endif   retrieve (Ext _ d) k = retrieve d k #if MIN_VERSION_base(4,8,0)-instance {-# OVERLAPPING #-} (IsDict d, IsDict (((k :-> v') ': d)), v' ~ v) => Retrieve (Dict ((k :-> v') ': d)) k v where+instance {-# OVERLAPPING #-} v' ~ v => Retrieve (Dict ((k :-> v') ': d)) k v where #else-instance                     (IsDict d, IsDict (((k :-> v') ': d)), v' ~ v) => Retrieve (Dict ((k :-> v') ': d)) k v where+instance                     v' ~ v => Retrieve (Dict ((k :-> v') ': d)) k v where #endif   retrieve (Ext (Value v) _) _ = v @@ -88,105 +93,38 @@ instance ToJSON (Dict s) => Show (Dict s) where   show = LT.unpack . LT.decodeUtf8 . encode -type AsDict s = Normalize (Sort s)--asDict :: (Sortable d, Normalizable (Sort d)) => Dict d -> Dict (AsDict d)-asDict = normalize . quicksort--type IsDict d = (d ~ Normalize (Sort d))--type Merge xs ys = Normalize (Sort (xs :++ ys))---- | Merge 2 dictionaries-merge :: (Mergeable a b) => Dict a -> Dict b -> Dict (Merge a b)-merge a b = asDict $ append a b+class Mergeable xs ys where+  merge :: Dict xs -> Dict ys -> Dict (Merge xs ys)+instance Mergeable xs '[] where+  merge xs Empty = xs+instance Mergeable '[] (y ': ys) where+  merge Empty ys = ys+instance (Conder (Cmp x y == 'EQ), Conder (Cmp x y == 'LT), Mergeable xs ys, Mergeable (x ': xs) ys, Mergeable xs (y ': ys)) => Mergeable (x ': xs) (y ': ys) where+  merge (Ext x xs) (Ext y ys) = cond (Proxy :: Proxy (Cmp x y == 'EQ))+                                     (Ext y (merge xs ys))+                                     (cond (Proxy :: Proxy (Cmp x y == 'LT))+                                           (Ext x (merge xs (Ext y ys)))+                                           (Ext y (merge (Ext x xs) ys))) -type Mergeable a b = (Sortable (a :++ b), Normalizable (Sort (a :++ b)))+type family Merge a b :: [*] where+  Merge xs '[] = xs+  Merge '[] ys = ys+  Merge (x ': xs) (y ': ys) = If (Cmp x y == 'EQ)+                                  (y ': Merge xs ys) -- select last one+                                  (If (Cmp x y == 'LT)+                                      (x ': Merge xs (y ': ys))+                                      (y ': Merge (x ': xs) ys))  type family Append (xs :: [k]) (ys :: [k]) :: [k] where   Append '[] ys = ys   Append (x ': xs) ys = x ': Append xs ys -type (xs :: [k]) :++ (ys :: [k]) = Append xs ys--append :: Dict xs -> Dict ys -> Dict (xs :++ ys)-append Empty ys = ys-append (Ext x xs) ys = Ext x (append xs ys)--type family Normalize d :: [*] where-  Normalize '[]           = '[]-  Normalize '[kv]         = '[kv]-  Normalize ((k :-> v1) ': (k :-> v2) ': d) = Normalize ((k :-> v2) ': d) -- select last one-  Normalize (kv1 ': kv2 ': d) = kv1 ': Normalize (kv2 ': d)--class Normalizable d where-  normalize :: Dict d -> Dict (Normalize d)-instance Normalizable '[] where-  normalize d = d-instance Normalizable '[kv] where-  normalize d = d-#if MIN_VERSION_base(4,8,0)-instance {-# OVERLAPPABLE #-} (Normalize (x ': y ': d) ~ (x ': Normalize (y ': d)), Normalizable (y ': d)) => Normalizable (x ': y ': d) where-#else-instance                      (Normalize (x ': y ': d) ~ (x ': Normalize (y ': d)), Normalizable (y ': d)) => Normalizable (x ': y ': d) where-#endif-  normalize (Ext x d) = Ext x (normalize d)-#if MIN_VERSION_base(4,8,0)-instance {-# OVERLAPPING #-} Normalizable ((k :-> v2) ': d) => Normalizable ((k :-> v1) ': (k :-> v2) ': d) where-#else-instance                     Normalizable ((k :-> v2) ': d) => Normalizable ((k :-> v1) ': (k :-> v2) ': d) where-#endif-  normalize (Ext _ d) = normalize d--type family Sort (xs :: [k]) :: [k] where-  Sort '[]       = '[]-  Sort (x ': xs) = Sort (Filter 'FMin x xs) :++ '[x] :++ Sort (Filter 'FMax x xs)--data Flag = FMin | FMax- type family Cmp (a :: k) (b :: k) :: Ordering type instance Cmp (k1 :-> v1) (k2 :-> v2) = CmpSymbol k1 k2 -type family Filter (f :: Flag) (p :: k) (xs :: [k]) :: [k] where-  Filter f    p '[]       = '[]-  Filter 'FMin p (x ': xs) = If (Cmp x p == 'LT) (x ': Filter 'FMin p xs) (Filter 'FMin p xs)-  Filter 'FMax p (x ': xs) = If (Cmp x p == 'GT || Cmp x p == 'EQ) (x ': Filter 'FMax p xs) (Filter 'FMax p xs)--class Sortable xs where-  quicksort :: Dict xs -> Dict (Sort xs)-instance Sortable '[] where-  quicksort Empty = Empty-instance ( Sortable (Filter 'FMin p xs)-         , Sortable (Filter 'FMax p xs)-         , FilterV 'FMin p xs-         , FilterV 'FMax p xs) => Sortable (p ': xs) where-  quicksort (Ext p xs) = quicksort (less p xs) `append`-                         Ext p Empty           `append`-                         quicksort (more p xs) where-    less = filterV (Proxy :: Proxy 'FMin)-    more = filterV (Proxy :: Proxy 'FMax)--class FilterV (f::Flag) p xs where-  filterV :: Proxy f -> p -> Dict xs -> Dict (Filter f p xs)-instance FilterV f p '[] where-  filterV _ _ _ = Empty- class Conder g where   cond :: Proxy g -> Dict s -> Dict t -> Dict (If g s t) instance Conder 'True where   cond _ s _ = s instance Conder 'False where   cond _ _ t = t--instance (Conder (Cmp x p == 'LT), FilterV 'FMin p xs) => FilterV 'FMin p (x ': xs) where-  filterV f@Proxy p (Ext x xs) =-    cond-    (Proxy :: Proxy (Cmp x p == 'LT))-    (Ext x (filterV f p xs))-    (filterV f p xs)-instance (Conder (Cmp x p == 'GT || Cmp x p == 'EQ), FilterV 'FMax p xs) => FilterV 'FMax p (x ': xs) where-  filterV f@Proxy p (Ext x xs) =-    cond-    (Proxy :: Proxy (Cmp x p == 'GT || Cmp x p == 'EQ))-    (Ext x (filterV f p xs))-    (filterV f p xs)

@@ -3,6 +3,9 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,9,0)+{-# LANGUAGE TypeApplications #-}+#endif module Main ( main ) where  #if MIN_VERSION_base(4,8,0)@@ -49,14 +52,25 @@   tmpl <- readTemplateFile def "example.tmpl"   expected @=? render tmpl (toJSON dict)     where+#if MIN_VERSION_base(4,9,0)+      dict = toDict @"a_variable" ("Hello,World!" :: T.Text) `merge`+             toDict @"navigation" [ toDict @"caption" ("A" :: LT.Text) `merge`+                                    toDict @"href" ("content/a.html" :: String)+                                  , toDict @"caption" "B" `merge`+                                    toDict @"href" "content/b.html"+                                  ] `merge`+             toDict @"foo" (1 :: Int) `merge`+             toDict @"bar" ("" :: String)+#else       dict = [key|a_variable|] ("Hello,World!" :: T.Text) `merge`              [key|navigation|] [ [key|caption|] ("A" :: LT.Text) `merge`                                  [key|href|] ("content/a.html" :: String)-                               , [key|caption|] ("B" :: LT.Text) `merge`-                                 [key|href|] ("content/b.html" :: String)+                               , [key|caption|] "B" `merge`+                                 [key|href|] "content/b.html"                                ] `merge`              [key|foo|] (1 :: Int) `merge`              [key|bar|] ("" :: String)+#endif  case_empty :: Assertion case_empty = do