From d2c9b2e2d8225261ee028b752dbb2640032c6ad7 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Sat, 28 Feb 2015 22:41:18 +0000 Subject: [PATCH 1/3] Grammar combinator for strings --- src/Language/JsonGrammar/Grammar.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/Language/JsonGrammar/Grammar.hs b/src/Language/JsonGrammar/Grammar.hs index 0127d64..33131e2 100644 --- a/src/Language/JsonGrammar/Grammar.hs +++ b/src/Language/JsonGrammar/Grammar.hs @@ -17,15 +17,15 @@ module Language.JsonGrammar.Grammar ( import Prelude hiding (id, (.)) import Control.Applicative ((<$>)) import Control.Category (Category(..)) -import Data.Aeson (Value, FromJSON(..), ToJSON(..)) +import Data.Aeson (Value, FromJSON(..), ToJSON(..), withText) import Data.Aeson.Types (Parser) import Data.Monoid (Monoid(..)) import Data.StackPrism (StackPrism, forward, backward, (:-)(..)) import Data.String (IsString(..)) import Data.Text (Text) import Language.TypeScript (Type(..), PredefinedType(..)) - - +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text -- Types @@ -201,3 +201,18 @@ defaultValue x = Pure f g -- | Create a 'pure' grammar from a 'StackPrism'. fromPrism :: StackPrism a b -> Grammar c a b fromPrism p = Pure (return . forward p) (backward p) + +-- | Grammar for strings +-- +-- (Defined explicitly rather than a Json instance so that we do not rely +-- on FlexibleInstances.) +string :: Grammar Val (Value :- t) (String :- t) +string = coerce (Predefined StringType) $ pure fr to + where + fr :: (Value :- t) -> Parser (String :- t) + fr (val :- t) = flip (Aeson.withText "String") val $ \txt -> + return (Text.unpack txt :- t) + + to :: (String :- t) -> Maybe (Value :- t) + to (str :- t) = + return (Aeson.String (Text.pack str) :- t) From f17538ff299bf64a257c494deb8702fd61c0e962 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Sat, 28 Feb 2015 22:44:15 +0000 Subject: [PATCH 2/3] Oops, sorry, remove redundant import --- src/Language/JsonGrammar/Grammar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/JsonGrammar/Grammar.hs b/src/Language/JsonGrammar/Grammar.hs index 33131e2..ea1d9f3 100644 --- a/src/Language/JsonGrammar/Grammar.hs +++ b/src/Language/JsonGrammar/Grammar.hs @@ -17,7 +17,7 @@ module Language.JsonGrammar.Grammar ( import Prelude hiding (id, (.)) import Control.Applicative ((<$>)) import Control.Category (Category(..)) -import Data.Aeson (Value, FromJSON(..), ToJSON(..), withText) +import Data.Aeson (Value, FromJSON(..), ToJSON(..)) import Data.Aeson.Types (Parser) import Data.Monoid (Monoid(..)) import Data.StackPrism (StackPrism, forward, backward, (:-)(..)) From 48ceb8fd7d556581008ebb809f58571f5e07b360 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Sun, 1 Mar 2015 00:04:17 +0000 Subject: [PATCH 3/3] Nicer definition --- src/Language/JsonGrammar/Grammar.hs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/Language/JsonGrammar/Grammar.hs b/src/Language/JsonGrammar/Grammar.hs index ea1d9f3..f4bf852 100644 --- a/src/Language/JsonGrammar/Grammar.hs +++ b/src/Language/JsonGrammar/Grammar.hs @@ -20,7 +20,7 @@ import Control.Category (Category(..)) import Data.Aeson (Value, FromJSON(..), ToJSON(..)) import Data.Aeson.Types (Parser) import Data.Monoid (Monoid(..)) -import Data.StackPrism (StackPrism, forward, backward, (:-)(..)) +import Data.StackPrism (StackPrism, stackPrism, forward, backward, (:-)(..)) import Data.String (IsString(..)) import Data.Text (Text) import Language.TypeScript (Type(..), PredefinedType(..)) @@ -202,17 +202,16 @@ defaultValue x = Pure f g fromPrism :: StackPrism a b -> Grammar c a b fromPrism p = Pure (return . forward p) (backward p) +-- | Apply a prism to the top of the stack +-- +-- TODO: It would be nicer if this was part of Data.StackPrism +top :: StackPrism a b -> StackPrism (a :- t) (b :- t) +top prism = stackPrism (\(a :- t) -> (forward prism a :- t)) + (\(b :- t) -> (:- t) `fmap` backward prism b) + -- | Grammar for strings -- -- (Defined explicitly rather than a Json instance so that we do not rely --- on FlexibleInstances.) +-- on OverlappingInstances.) string :: Grammar Val (Value :- t) (String :- t) -string = coerce (Predefined StringType) $ pure fr to - where - fr :: (Value :- t) -> Parser (String :- t) - fr (val :- t) = flip (Aeson.withText "String") val $ \txt -> - return (Text.unpack txt :- t) - - to :: (String :- t) -> Maybe (Value :- t) - to (str :- t) = - return (Aeson.String (Text.pack str) :- t) +string = fromPrism (top (stackPrism Text.unpack (Just . Text.pack))) . grammar