elm-export-persistent (empty) → 0.1.1

raw patch · 7 files changed

+346/−0 lines, 7 filesdep +aesondep +basedep +elm-exportsetup-changed

Dependencies added: aeson, base, elm-export, persistent, scientific, text, unordered-containers

Files

ChangeLog.md +5/−0
LICENSE +22/−0
Setup.hs +2/−0
elm-export-persistent.cabal +45/−0
src/Elm/Export/Persist.hs +141/−0
src/Elm/Export/Persist/BackendKey.hs +27/−0
src/Elm/Export/Persist/Ent.hs +104/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for elm-export-persistent++## 0.1.0.0  -- 2016-12-12++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,22 @@+MIT++Copyright (c) 2016 William Casarin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ elm-export-persistent.cabal view

@@ -0,0 +1,45 @@+-- Initial elm-export-persistent.cabal generated by cabal init.  For+-- further documentation, see http://haskell.org/cabal/users-guide/++name:                elm-export-persistent+version:             0.1.1+synopsis:            elm-export persistent entities+description:+  Ent is a newtype that wraps Persistent Entity's, allowing you to export them+  to Elm types. Specifically, it adds a To/From JSON instance which adds an id+  field, as well as an ElmType instance that adds an id field constructor.+homepage:            https://github.com/jb55/elm-export-persistent+license:             MIT+license-file:        LICENSE+author:              William Casarin+maintainer:          bill@casarin.me+-- copyright:+category:            Web, Database, Data+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10+tested-with:         GHC == 7.10.1+                   , GHC == 7.10.2+                   , GHC == 7.10.3+                   , GHC == 8.0.1+                   , GHC == 8.0.2++source-repository head+  type:     git+  location: https://github.com/jb55/elm-export-persistent++library+  exposed-modules: Elm.Export.Persist+                 , Elm.Export.Persist.Ent+                 , Elm.Export.Persist.BackendKey+  -- other-modules:+  -- other-extensions:+  build-depends: base >=4.8 && <5+               , elm-export+               , persistent+               , aeson+               , text+               , unordered-containers+               , scientific+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Elm/Export/Persist.hs view

@@ -0,0 +1,141 @@+-- |+-- Module      :  Elm.Export.Persist+-- Copyright   :  (C) 2016-17 William Casarin+-- License     :  MIT+-- Maintainer  :  William Casarin <bill@casarin.me>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- == Usage+-- #usage#+--+-- @+-- newtype 'Ent' (field :: 'Symbol') a = 'Ent' ('Entity' a)+--   deriving ('Generic')+--+-- type 'EntId' a = 'Ent' "id" a+-- @+--+-- 'Ent' is a newtype that wraps Persistent 'Entity's, allowing you to export+-- them to Elm types. Specifically, it adds a {To,From}JSON instance which+-- adds an @id@ field, as well as an @'ElmType'@ instance that adds an @id@+-- field constructor.+--+-- == Example+-- #example#+--+-- Let\'s define a Persistent model:+--+-- @+-- {-\# LANGUAGE FlexibleInstances #-}+-- {-\# LANGUAGE GADTs #-}+-- {-\# LANGUAGE GeneralizedNewtypeDeriving #-}+-- {-\# LANGUAGE MultiParamTypeClasses #-}+-- {-\# LANGUAGE OverloadedStrings #-}+-- {-\# LANGUAGE QuasiQuotes #-}+-- {-\# LANGUAGE TemplateHaskell #-}+-- {-\# LANGUAGE TypeFamilies #-}+-- {-\# LANGUAGE DeriveGeneric #-}+-- {-\# LANGUAGE StandaloneDeriving #-}+--+-- module Main where+--+-- import Data.Aeson+-- import Data.'Text'+-- import Database.Persist.TH+-- import Elm+-- import GHC.Generics+--+-- import Elm.Export.Persist+-- import Elm.Export.Persist.BackendKey ()+--+-- share [mkPersist sqlSettings, mkMigrate "migrateAccount"] [persistLowerCase|+-- Account+--   email 'Text'+--   password 'Text'+--   deriving Show 'Generic'+--   UniqueEmail email+-- |]+--+-- instance 'ToJSON' Account+-- instance 'FromJSON' Account+-- instance 'ElmType' Account+--+-- -- use GeneralizedNewtypeDeriving for ids+-- -- this picks a simpler int-encoding+-- deriving instance 'ElmType' AccountId+-- @+--+-- Now let\'s export it with an id field:+--+-- @+-- module Main where+--+-- import Db+-- import Elm+-- import Data.Proxy+--+-- mkSpecBody :: 'ElmType' a => a -> ['Text']+-- mkSpecBody a =+--   [ toElmTypeSource    a+--   , toElmDecoderSource a+--   , toElmEncoderSource a+--   ]+--+-- defImports :: ['Text']+-- defImports =+--   [ "import Json.Decode exposing (..)"+--   , "import Json.Decode.Pipeline exposing (..)"+--   , "import Json.Encode"+--   , "import Http"+--   , "import String"+--   ]+--+-- accountSpec :: Spec+-- accountSpec =+--   Spec [\"Generated\", \"Account\"] $+--        defImports ++ mkSpecBody ('Proxy' :: 'Proxy' ('EntId' Account))+--+-- main :: IO ()+-- main = specsToDir [accountSpec] \"some\/where\/output\"+-- @+--+-- This generates:+--+-- @+-- module Generated.Account exposing (..)+--+-- import Json.Decode exposing (..)+-- import Json.Decode.Pipeline exposing (..)+-- import Json.Encode+-- import Http+-- import String+--+-- type alias Account =+--     { accountEmail : String+--     , accountPassword : String+--     , id : Int+--     }+--+-- decodeAccount : Decoder Account+-- decodeAccount =+--     decode Account+--         |> required "accountEmail" string+--         |> required "accountPassword" string+--         |> required "id" int+--+-- encodeAccount : Account -> Json.Encode.Value+-- encodeAccount x =+--     Json.Encode.object+--         [ ( "accountEmail", Json.Encode.string x.accountEmail )+--         , ( "accountPassword", Json.Encode.string x.accountPassword )+--         , ( "id", Json.Encode.int x.id )+--         ]+-- @++module Elm.Export.Persist+  ( module Elm.Export.Persist.Ent+  )+  where++import Elm.Export.Persist.Ent

+ src/Elm/Export/Persist/BackendKey.hs view

@@ -0,0 +1,27 @@+-- |+-- Module      :  Elm.Export.Persist.Ent+-- Copyright   :  (C) 2016-17 William Casarin+-- License     :  MIT+-- Maintainer  :  William Casarin <bill@casarin.me>+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Orphan instances needed for SQL keys+--+-- This is usually required, but optionally exported in case you have your own+-- already++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Elm.Export.Persist.BackendKey () where++import GHC.Generics+import Elm+import Database.Persist+import Database.Persist.Sql++deriving instance Generic (BackendKey SqlBackend)+deriving instance ElmType (BackendKey SqlBackend)

+ src/Elm/Export/Persist/Ent.hs view

@@ -0,0 +1,104 @@+-- |+-- Module      :  Elm.Export.Persist.Ent+-- Copyright   :  (C) 2016-17 William Casarin+-- License     :  MIT+-- Maintainer  :  William Casarin <bill@casarin.me>+-- Stability   :  experimental+-- Portability :  non-portable++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds #-}++module Elm.Export.Persist.Ent+    ( Ent(..)+    , EntId+    ) where++import Database.Persist+import Database.Persist.Sql+import Data.Aeson+import Elm+import Data.Proxy+import Data.Text+import Data.Scientific+import GHC.TypeLits+import GHC.Generics++import qualified Data.HashMap.Strict as Map+import qualified Data.Text as T++-- | 'Entity' wrapper that adds `ToJSON`, `FromJSON`, and `ElmType` instances+--+-- The first type parameter 'field' is a symbol used for the key name+--+-- >>> toElmTypeSource (Proxy :: Proxy (Ent "userId" User))+-- "type alias User = { userName : String, userId : Int }"+newtype Ent (field :: Symbol) a = Ent (Entity a)+  deriving (Generic)++-- | 'Ent' alias, using "id" as the key+--+-- >>> toElmTypeSource (Proxy :: Proxy (EntId User))+-- "type alias User = { userName : String, id : Int }"+type EntId a = Ent "id" a++elmIdField :: Text -> ElmValue+elmIdField keyfield =+  ElmField keyfield (ElmPrimitiveRef EInt)++addIdToVals :: String -> ElmValue -> ElmValue+addIdToVals keyname ev =+  case ev of+    ef@(ElmField{}) ->+      Values ef (elmIdField (T.pack keyname))+    Values v1 rest -> Values v1 (addIdToVals keyname rest)+    _ -> ev+++instance (KnownSymbol field, ElmType a) => ElmType (Ent field a) where+  toElmType _ =+    case toElmType (Proxy :: Proxy a) of+      ElmDatatype name (RecordConstructor x (Values v vals)) ->+        ElmDatatype name (RecordConstructor x+                            (Values v (addIdToVals keyname vals)))+      x -> x+    where+      keyname :: String+      keyname = symbolVal (Proxy :: Proxy field)++instance (KnownSymbol field, ToJSON a) => ToJSON (Ent field a) where+  toJSON (Ent (Entity k val)) =+    case toJSON val of+      Object hmap -> Object (Map.insert keyname (toJSON k) hmap)+      x           -> x+    where+      keyname :: Text+      keyname = T.pack $ symbolVal (Proxy :: Proxy field)++valToKey :: ToBackendKey SqlBackend record => Value -> Maybe (Key record)+valToKey (Number n) = toSqlKey <$> toBoundedInteger n+valToKey _          = Nothing++instance ( ToBackendKey SqlBackend a+         , PersistEntity a+         , KnownSymbol field+         , FromJSON a) => FromJSON (Ent field a) where+  parseJSON obj@(Object o) =+    let+      keyname :: String+      keyname = symbolVal (Proxy :: Proxy field)+      mkey = Map.lookup (T.pack keyname) o+      keyParser = do key <- maybe (fail $ "Ent: no key found for field " ++ keyname)+                            pure mkey+                     maybe (fail "Ent: could not parse key as Int64")+                           pure (valToKey key)+    in+      Ent <$>+        (Entity <$> keyParser+                <*> parseJSON obj)+  parseJSON _ = fail "Ent: should be an Object"+