packages feed

elm-export 0.4.0.1 → 0.4.1.0

raw patch · 7 files changed

+194/−134 lines, 7 filesdep +formattingdep ~elm-exportPVP ok

version bump matches the API change (PVP)

Dependencies added: formatting

Dependency ranges changed: elm-export

API changes (from Hackage documentation)

Files

elm-export.cabal view
@@ -1,5 +1,5 @@ name: elm-export-version: 0.4.0.1+version: 0.4.1.0 cabal-version: >=1.10 build-type: Simple license: OtherLicense@@ -26,6 +26,7 @@         bytestring >=0.10.6.0 && <0.11,         containers >=0.5.6.2 && <0.6,         directory >=1.2.2.0 && <1.3,+        formatting >=6.2.2 && <6.3,         mtl >=2.2.1 && <2.3,         text >=1.2.2.0 && <1.3,         time >=1.5.0.1 && <1.6@@ -47,7 +48,7 @@         base >=4.8.2.0 && <4.9,         bytestring >=0.10.6.0 && <0.11,         containers >=0.5.6.2 && <0.6,-        elm-export >=0.4.0.1 && <0.5,+        elm-export >=0.4.1.0 && <0.5,         hspec >=2.2.2 && <2.3,         hspec-core >=2.2.2 && <2.3,         quickcheck-instances >=0.3.12 && <0.4,
src/Elm/Common.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE OverloadedStrings #-} module Elm.Common  where +import           Data.Monoid ((<>))+import           Data.Text import           Elm.Type  isTopLevel :: ElmTypeExpr -> Bool@@ -10,12 +13,12 @@  -- Put parentheses around the string if the Elm type requires it (i.e. it's not a -- Primitive Elm type nor a named DataType).-parenthesize :: ElmTypeExpr -> String -> String+parenthesize :: ElmTypeExpr -> Text -> Text parenthesize t s =-  if isTopLevel t then s else "(" ++ s ++ ")"+  if isTopLevel t then s else ("(" <> s <> ")")  data Options =-  Options {fieldLabelModifier :: String -> String}+  Options {fieldLabelModifier :: Text -> Text}  defaultOptions :: Options defaultOptions = Options {fieldLabelModifier = id}
src/Elm/Decoder.hs view
@@ -1,68 +1,83 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators     #-} -module Elm.Decoder (toElmDecoderSource, toElmDecoderSourceWith)-       where+module Elm.Decoder+  ( toElmDecoderSource+  , toElmDecoderSourceWith+  ) where  import           Control.Monad.Reader+import           Data.Text import           Elm.Common import           Elm.Type-import           Text.Printf+import           Formatting -render :: ElmTypeExpr -> Reader Options String+cr :: Format r r+cr = now "\n" +render :: ElmTypeExpr -> Reader Options Text+ render (TopLevel (DataType d t)) =-  printf "%s : Decoder %s\n%s =\n%s" fnName d fnName <$> render t-  where fnName = "decode" ++ d+    sformat+        (stext % " : Decoder " % stext % cr % stext % " =" % cr % stext)+        fnName+        d+        fnName <$>+    render t+  where+    fnName = sformat ("decode" % stext) d -render (DataType d _) = return $ "decode" ++ d+render (DataType d _) = pure $ sformat ("decode" % stext) d -render (Record n t) = printf "    decode %s\n%s" n <$> render t+render (Record n t) =+    sformat ("    decode " % stext % cr % stext) n <$> render t -render (Product (Primitive "List") (Primitive "Char")) = render (Primitive "String")+render (Product (Primitive "List") (Primitive "Char")) =+    render (Primitive "String") -render (Product (Primitive "List") t) = printf "(list %s)" <$> render t+render (Product (Primitive "List") t) =+    sformat ("(list " % stext % ")") <$> render t -render (Product (Primitive "Maybe") t) = printf "(maybe %s)" <$> render t+render (Product (Primitive "Maybe") t) =+    sformat ("(maybe " % stext % ")") <$> render t  render (Product x y) =-  do bodyX <- render x-     bodyY <- render y-     return $ printf "%s\n%s" bodyX bodyY+    sformat (stext % cr % stext) <$> render x <*> render y -render (Selector n t) =-  do fieldModifier <- asks fieldLabelModifier-     printf "        |> required \"%s\" %s" (fieldModifier n) <$> render t+render (Selector n t) = do+    fieldModifier <- asks fieldLabelModifier+    sformat+        ("        |> required \"" % stext % "\" " % stext)+        (fieldModifier n) <$>+        render t  render (Tuple2 x y) =-    do bodyX <- render x-       bodyY <- render y-       return $ printf "(tuple2 (,) %s %s)" bodyX bodyY+    sformat ("(tuple2 (,) " % stext % " " % stext % ")") <$> render x <*>+    render y  render (Dict x y) =-  printf "(map Dict.fromList (list %s))" <$> render (Tuple2 x y)--render (Primitive "String") = return "string"--render (Primitive "Int") = return "int"--render (Primitive "Double") = return "float"--render (Primitive "Float") = return "float"--render (Primitive "Date") = return "(customDecoder string Date.fromString)"--render (Primitive "Bool") = return "bool"+    sformat ("(map Dict.fromList (list " % stext % "))") <$>+    render (Tuple2 x y) +render (Primitive "String") = pure "string"+render (Primitive "Int") = pure "int"+render (Primitive "Double") = pure "float"+render (Primitive "Float") = pure "float"+render (Primitive "Date") = pure "(customDecoder string Date.fromString)"+render (Primitive "Bool") = pure "bool" render (Field t) = render t+render x = pure $ sformat ("<" % shown % ">") x -render x = return $ printf "<%s>" (show x) -toElmDecoderSourceWith :: ElmType a => Options -> a -> String-toElmDecoderSourceWith options x =-  runReader (render . TopLevel $ toElmType x) options+toElmDecoderSourceWith+    :: ElmType a+    => Options -> a -> Text+toElmDecoderSourceWith options x = runReader (render . TopLevel $ toElmType x) options -toElmDecoderSource :: ElmType a => a -> String+toElmDecoderSource+    :: ElmType a+    => a -> Text toElmDecoderSource = toElmDecoderSourceWith defaultOptions
src/Elm/Encoder.hs view
@@ -1,50 +1,58 @@+{-# LANGUAGE OverloadedStrings #-} module Elm.Encoder (toElmEncoderSource, toElmEncoderSourceWith)        where  import           Control.Monad.Reader+import           Data.Text import           Elm.Common import           Elm.Type-import           Text.Printf+import           Formatting -render :: ElmTypeExpr -> Reader Options String+render :: ElmTypeExpr -> Reader Options Text  render (TopLevel (DataType d t)) =-  printf "%s : %s -> Value\n%s x =%s" fnName d fnName <$> render t-  where fnName = "encode" ++ d+    sformat+        (stext % " : " % stext % " -> Value\n" % stext % " x =" % stext)+        fnName+        d+        fnName <$>+    render t+  where+    fnName = sformat ("encode" % stext) d -render (DataType d _) = return $ "encode" ++ d+render (DataType d _) = return $ sformat ("encode" % stext) d  render (Record _ t) =-  printf "\n    object\n        [ %s\n        ]" <$> render t+  sformat ("\n    object\n        [ " % stext % "\n        ]") <$> render t  render (Product (Primitive "List") (Primitive "Char")) =   render (Primitive "String")  render (Product (Primitive "List") t) =-  printf "(list << List.map %s)" <$> render t+  sformat ("(list << List.map " % stext % ")") <$> render t  render (Product (Primitive "Maybe") t) =-  printf "(Maybe.withDefault null << Maybe.map %s)" <$> render t+  sformat ("(Maybe.withDefault null << Maybe.map " % stext % ")") <$> render t  render (Tuple2 x y) =   do bodyX <- render x      bodyY <- render y-     return $ printf "tuple2 %s %s" bodyX bodyY+     return $ sformat ("tuple2 " % stext % " " % stext) bodyX bodyY  render (Dict x y) =   do bodyX <- render x      bodyY <- render y-     return $ printf "dict %s %s" bodyX bodyY+     return $ sformat ("dict " % stext % " " % stext) bodyX bodyY  render (Product x y) =   do bodyX <- render x      bodyY <- render y-     return $ printf "%s\n        , %s" bodyX bodyY+     return $ sformat (stext % "\n        , " % stext) bodyX bodyY  render (Selector n t) =   do fieldModifier <- asks fieldLabelModifier      typeBody <- render t-     return $ printf "( \"%s\", %s x.%s )" (fieldModifier n) typeBody n+     return $ sformat ("( \"" % stext % "\", " % stext % " x." % stext % " )") (fieldModifier n) typeBody n  render  (Primitive "String") = return "string" render  (Primitive "Int") = return "int"@@ -54,8 +62,8 @@ render  (Primitive "Bool") = return "bool" render  (Field t) = render t -toElmEncoderSourceWith :: ElmType a => Options -> a -> String+toElmEncoderSourceWith :: ElmType a => Options -> a -> Text toElmEncoderSourceWith options x = runReader (render . TopLevel $ toElmType x) options -toElmEncoderSource :: ElmType a => a -> String+toElmEncoderSource :: ElmType a => a -> Text toElmEncoderSource = toElmEncoderSourceWith defaultOptions
src/Elm/Record.hs view
@@ -1,73 +1,73 @@+{-# LANGUAGE OverloadedStrings #-} module Elm.Record (toElmTypeSource,toElmTypeSourceWith) where  import           Control.Monad.Reader import           Elm.Common import           Elm.Type-import           Text.Printf+import           Formatting+import Data.Text -render :: ElmTypeExpr -> Reader Options String+render :: ElmTypeExpr -> Reader Options Text  render (TopLevel (DataType dataTypeName record@(Record _ _))) =-  printf "type alias %s =\n    { %s\n    }" dataTypeName <$> render record+    sformat ("type alias " % stext % " =\n    { " % stext % "\n    }") dataTypeName <$>+    render record  render (TopLevel (DataType d s@(Sum _ _))) =-  printf "type %s\n    = %s" d <$> render s+    sformat ("type " % stext % "\n    = " % stext) d <$> render s + render (DataType d _) = return d render (Primitive s) = return s  render (Sum x y) =-    do bodyX <- render x-       bodyY <- render y-       return $ printf "%s\n    | %s" bodyX bodyY+    sformat (stext % "\n    | " % stext) <$> render x <*> render y + render (Field t) = render t -render (Selector s t) = do fieldModifier <- asks fieldLabelModifier-                           printf "%s : %s" (fieldModifier s) <$> render t+render (Selector s t) = do+    fieldModifier <- asks fieldLabelModifier+    sformat (stext % " : " % stext) (fieldModifier s) <$> render t  render (Constructor c Unit) = pure c -render (Constructor c t) = printf "%s %s" c <$> render t+render (Constructor c t) = sformat (stext % " " % stext) c <$> render t  render (Tuple2 x y) =-    do bodyX <- render x-       bodyY <- render y-       return $ printf "( %s, %s )" bodyX bodyY+    sformat ("( " % stext % ", " % stext % " )") <$> render x <*> render y  render (Dict x y) =-    do bodyX <- render x-       bodyY <- render y-       return $ printf "Dict %s %s" bodyX bodyY+    sformat ("Dict " % stext % " " % stext) <$> render x <*> render y + render (Product (Primitive "List") (Primitive "Char")) = return "String"  render (Product (Primitive "List") p@(Product _ _)) =-  printf "List (%s)" <$> render p+  sformat ("List (" % stext % ")") <$> render p -render (Product (Primitive "List") t) = printf "List %s" <$> render t+render (Product (Primitive "List") t) = sformat ("List " % stext) <$> render t  render (Product (Primitive "Dict") (Product k v)) =-  do keyBody <- render k-     valueBody <- render v-     return $ printf "Dict %s %s" keyBody valueBody+    sformat ("Dict " % stext % " " % stext) <$> render k <*> render v + render (Product x y) =   do bodyX <- render x      bodyY <- render y-     return $ printf ("%s " ++ parenthesize y "%s") bodyX bodyY+     return $ sformat (stext % " " % stext) bodyX (parenthesize y  bodyY)  render (Record n (Product x y)) =   do bodyX <- render (Record n x)      bodyY <- render (Record n y)-     return $ printf "%s\n    , %s" bodyX bodyY+     return $ sformat (stext % "\n    , " % stext) bodyX bodyY  render (Record _ s@(Selector _ _)) = render s  render Unit = return "" -toElmTypeSourceWith :: ElmType a => Options -> a -> String+toElmTypeSourceWith :: ElmType a => Options -> a -> Text toElmTypeSourceWith options x = runReader (render . TopLevel $ toElmType x) options -toElmTypeSource :: ElmType a => a -> String+toElmTypeSource :: ElmType a => a -> Text toElmTypeSource = toElmTypeSourceWith defaultOptions
src/Elm/Type.hs view
@@ -2,10 +2,13 @@ {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE GADTs               #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators       #-}+ module Elm.Type where +import           Data.Int     (Int16, Int32, Int64, Int8) import           Data.Map import           Data.Proxy import           Data.Text@@ -17,23 +20,23 @@ -- there are fewer (or hopefully zero) representable illegal states. data ElmTypeExpr where         TopLevel :: ElmTypeExpr -> ElmTypeExpr-        DataType :: String -> ElmTypeExpr -> ElmTypeExpr-        Record :: String -> ElmTypeExpr -> ElmTypeExpr-        Constructor :: String -> ElmTypeExpr -> ElmTypeExpr-        Selector :: String -> ElmTypeExpr -> ElmTypeExpr+        DataType :: Text -> ElmTypeExpr -> ElmTypeExpr+        Record :: Text -> ElmTypeExpr -> ElmTypeExpr+        Constructor :: Text -> ElmTypeExpr -> ElmTypeExpr+        Selector :: Text -> ElmTypeExpr -> ElmTypeExpr         Field :: ElmTypeExpr -> ElmTypeExpr         Sum :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr         Dict :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr         Tuple2 :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr         Product :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr         Unit :: ElmTypeExpr-        Primitive :: String -> ElmTypeExpr+        Primitive :: Text -> ElmTypeExpr     deriving (Eq, Show)  class ElmType a  where-  toElmType :: a -> ElmTypeExpr-  default toElmType :: (Generic a,GenericElmType (Rep a)) => a -> ElmTypeExpr-  toElmType = genericToElmType . from+    toElmType :: a -> ElmTypeExpr+    toElmType = genericToElmType . from+    default toElmType :: (Generic a, GenericElmType (Rep a)) => a -> ElmTypeExpr  instance ElmType Bool where     toElmType _ = Primitive "Bool"@@ -62,58 +65,85 @@ instance ElmType Integer where     toElmType _ = Primitive "Int" -instance (ElmType a,ElmType b) => ElmType (a,b) where-  toElmType _ =-    Tuple2 (toElmType (Proxy :: Proxy a))-           (toElmType (Proxy :: Proxy b))+instance ElmType Int8 where+    toElmType _ = Primitive "Int" -instance ElmType a => ElmType [a] where+instance ElmType Int16 where+    toElmType _ = Primitive "Int"++instance ElmType Int32 where+    toElmType _ = Primitive "Int"++instance ElmType Int64 where+    toElmType _ = Primitive "Int"++instance (ElmType a, ElmType b) =>+         ElmType (a, b) where+    toElmType _ =+        Tuple2 (toElmType (Proxy :: Proxy a)) (toElmType (Proxy :: Proxy b))++instance ElmType a =>+         ElmType [a] where     toElmType _ = Product (Primitive "List") (toElmType (Proxy :: Proxy a)) -instance ElmType a => ElmType (Maybe a) where-  toElmType _ = Product (Primitive "Maybe") (toElmType (Proxy :: Proxy a))+instance ElmType a =>+         ElmType (Maybe a) where+    toElmType _ = Product (Primitive "Maybe") (toElmType (Proxy :: Proxy a)) -instance (ElmType k,ElmType v) => ElmType (Map k v) where-  toElmType _ =-    Dict (toElmType (Proxy :: Proxy k))-         (toElmType (Proxy :: Proxy v))+instance (ElmType k, ElmType v) =>+         ElmType (Map k v) where+    toElmType _ =+        Dict (toElmType (Proxy :: Proxy k)) (toElmType (Proxy :: Proxy v)) -instance ElmType a => ElmType (Proxy a) where-  toElmType _ = toElmType (undefined :: a)+instance ElmType a =>+         ElmType (Proxy a) where+    toElmType _ = toElmType (undefined :: a) +------------------------------------------------------------+ class GenericElmType f  where-  genericToElmType :: f a -> ElmTypeExpr+    genericToElmType :: f a -> ElmTypeExpr -instance (GenericElmType f,Datatype d) => GenericElmType (D1 d f) where-  genericToElmType d@(M1 x) =-    DataType (datatypeName d)-             (genericToElmType x)+instance (Datatype d, GenericElmType f) =>+         GenericElmType (D1 d f) where+    genericToElmType datatype =+        DataType+            (pack (datatypeName datatype))+            (genericToElmType (unM1 datatype)) -instance (Constructor c,GenericElmType f) => GenericElmType (C1 c f) where-  genericToElmType c@(M1 x) =-    if conIsRecord c-       then Record name body-       else Constructor name body-    where name = conName c-          body = genericToElmType x+instance (Constructor c, GenericElmType f) =>+         GenericElmType (C1 c f) where+    genericToElmType constructor =+        if conIsRecord constructor+            then Record name body+            else Constructor name body+      where+        name = pack $ conName constructor+        body = genericToElmType (unM1 constructor) -instance (Selector c,GenericElmType f) => GenericElmType (S1 c f) where-  genericToElmType s@(M1 x) =-    Selector (selName s)-             (genericToElmType x)+instance (Selector c, GenericElmType f) =>+         GenericElmType (S1 c f) where+    genericToElmType selector =+        Selector (pack (selName selector)) (genericToElmType (unM1 selector))  instance GenericElmType U1 where-  genericToElmType _  = Unit+    genericToElmType _ = Unit -instance (ElmType c) => GenericElmType (K1 R c) where-  genericToElmType (K1 x) = Field (toElmType x)+instance (ElmType c) =>+         GenericElmType (Rec0 c) where+    genericToElmType parameter = Field (toElmType (unK1 parameter)) -instance (GenericElmType f,GenericElmType g) => GenericElmType (f :+: g) where-  genericToElmType _ = Sum-           (genericToElmType (undefined :: f p))-           (genericToElmType (undefined :: g p)) -instance (GenericElmType f,GenericElmType g) => GenericElmType (f :*: g) where-  genericToElmType _ =-    Product (genericToElmType (undefined :: f p))+instance (GenericElmType f, GenericElmType g) =>+         GenericElmType (f :+: g) where+    genericToElmType _ =+        Sum+            (genericToElmType (undefined :: f p))+            (genericToElmType (undefined :: g p))++instance (GenericElmType f, GenericElmType g) =>+         GenericElmType (f :*: g) where+    genericToElmType _ =+        Product+            (genericToElmType (undefined :: f p))             (genericToElmType (undefined :: g p))
test/ExportSpec.hs view
@@ -6,6 +6,7 @@  import           Data.Char import           Data.Map+import           Data.Monoid import           Data.Proxy import           Data.Text    hiding (unlines) import           Data.Time@@ -244,9 +245,11 @@   do source <- readFile fileExpected      actual `shouldBe` source -initCap :: String -> String-initCap [] = []-initCap (c:cs) = Data.Char.toUpper c : cs+initCap :: Text -> Text+initCap t =+    case uncons t of+        Nothing -> t+        Just (c, cs) -> cons (Data.Char.toUpper c) cs -withPrefix :: String -> String -> String-withPrefix prefix s = prefix ++ initCap s+withPrefix :: Text -> Text -> Text+withPrefix prefix s = prefix <> ( initCap  s)