Inspired by this two comments on reddit I set out to create a 'lensified entity system'. The basic idea is to have Lens' Entity Value lenses, but although there is Action to create Getters with side effects there is no Setter or a combined LensM' -thing.
I could probably use something like Lens' (Entity, State) Value but I would be interested in how (and if) this could be done in a better way.
Ok ... here is what I got:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import qualified Data.Map as M
import Control.Monad.State
import Control.Lens
newtype Entity = Entity { unEntity :: Int }
deriving (Show, Eq, Ord, Enum)
type Address = String
type Name = String
data EntitySystem = EntitySystem {
_nextEntity :: Entity,
_addresses :: M.Map Entity Address,
_names :: M.Map Entity Name
} deriving (Show, Eq, Ord)
makeLenses ''EntitySystem
newEntry :: Name -> Address -> State EntitySystem Entity
newEntry name addr = do
ne <- nextEntity <<%= succ
addresses.at ne ?= addr
names.at ne ?= name
return ne
entityAddress e = addresses . at e
entityName e = names . at e
Basically I can use entityAddress entity (which should be of type Entity -> Lens' EntitySystem Address but ghc is complaining). But this doesn't feel 'lensy'. What I am hoping for is something like entityAddress :: Lens' Entity Address where all the stateful handling of the entity system is hidden from the user.
Related
Let's say I have a Person record with some fields:
data Person = Person
{ name :: String
, age :: Int
, id :: Int
}
and I want to be able to search a list of Persons by a given field:
findByName :: String -> [Person] -> Maybe Person
findByName s = find (\p -> name p == s)
Now let's say I want to be able to model and store these searches/queries as data, for instance for logging purposes, or to batch execute them, or whatever.
How would I go about representing a search over a given field (or set of fields) as data?
My intuition says to model it as a map of fields to string values (Map (RecordField) (Maybe String)), but I can't do that, because record fields are functions.
Is there a better way to do this than, say, the following?
data PersonField = Name | Age | Int
type Search = Map PersonField (Maybe String)
This could technically work but it decouples PersonField from Person in an ugly way.
I want to be able to model and store these searches/queries as data
Let's assume we want to store them as JSON. We could define a type like
data Predicate record = Predicate {
runPredicate :: record -> Bool ,
storePredicate :: Value
}
Where storePredicate would return a JSON representation of the "reference value" inside the predicate. For example, the value 77 for "age equals 77".
For each record, we would like to have a collection like this:
type FieldName = String
type FieldPredicates record = [(FieldName, Value -> Maybe (Predicate record))]
That is: for each field, we can supply a JSON value encoding the "reference value" of the predicate and, if it parses successfully, we get a Predicate. Otherwise we get Nothing. This would allows us to serialize and deserialize predicates.
We could define FieldPredicates manually for each record, but is there a more automated way? We could try generating field equality predicates using a typeclass. But first, the extensions and imports dance:
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE BlockArguments #-}
import Data.Functor ( (<&>) )
import Data.Kind ( Type, Constraint )
import Data.Proxy
import GHC.Records ( HasField(..) )
import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
import Data.Aeson ( FromJSON(parseJSON), Value, ToJSON(toJSON) )
import Data.Aeson.Types (parseMaybe)
import Data.List ( lookup )
Now we define the helper typeclass:
type HasEqFieldPredicates :: [Symbol] -> Type -> Constraint
class HasEqFieldPredicates fieldNames record where
eqFieldPredicates :: FieldPredicates record
instance HasEqFieldPredicates '[] record where
eqFieldPredicates = []
instance
( KnownSymbol fieldName,
HasField fieldName record v,
Eq v,
FromJSON v,
ToJSON v,
HasEqFieldPredicates fieldNames record
) =>
HasEqFieldPredicates (fieldName ': fieldNames) record
where
eqFieldPredicates =
let current =
( symbolVal (Proxy #fieldName),
\j ->
parseMaybe (parseJSON #v) j <&> \v ->
Predicate (\record -> getField #fieldName record == v) (toJSON v))
in current : eqFieldPredicates #fieldNames #record
An example with Person:
personEqPredicates :: [(FieldName, Value -> Maybe (Predicate Person))]
personEqPredicates = eqFieldPredicates #["name", "age", "id"] #Person
personAgeEquals :: Value -> Maybe (Predicate Person)
personAgeEquals = let Just x = Data.List.lookup "age" personEqPredicates in x
Putting it to work:
ghci> let Just p = personAgeEquals (toJSON (77::Int)) in runPredicate p Person { name = "John", age = 78, id = 3 }
False
ghci> let Just p = personAgeEquals (toJSON (78::Int)) in runPredicate p Person { name = "John", age = 78, id = 3 }
True
If you don't need to serialize these query objects to disk, then your "field" type is Person -> a. A record accessor is just a function from Person to some type a. Or if you end up outgrowing basic accessors and need to work with a lot of nested data, you can look into lenses.
However, it sounds like you want to be able to write these queries to disk. In that case, you can't easily serialize functions (or lenses, for that matter). I don't know of a way built-in to Haskell to do all of that automatically and still have it be serializable. So my recommendation would be to roll your own datatypes.
data PersonField = Name | Age | Id
or, even better, you can use GADTs to keep type safety.
data PersonField a where
Name :: PersonField String
Age :: PersonField Int
Id :: PersonField Int
getField :: PersonField a -> Person -> a
getField Name = name
getField Age = age
getField Id = id
Then you have total control over this concrete type and can write your own serialization logic for it. I think Map PersonField (Maybe String) is a good start, and you can refine the Maybe String part if you end up doing more complex queries (like "contains" or "case insensitive comparison", for instance).
This is a stupid question, and I have tried to understand from different tutorials. When having a JSON with capital case Haskell crashes as explained by others (https://mail.haskell.org/pipermail/beginners/2013-October/012865.html). As suggested it could be solved with deriving from deriveFromJSON. DeriveJSON requires a function input, how should I write the derive statement in the below code? I am missing something in my understanding, and would appreciate any help.
import Data.Aeson.TH
data Person = Person {
Foo :: String
, bar :: String
} deriving (Eq, Show, deriveJSON)
main = do
let b = Person "t" "x"
print b
deriveJSON and friends are Template Haskell functions which will generate instances for you. As such, you should not try to list them in the deriving clause. Instead, call them in a splice at the top level like this:
{-# LANGUAGE TemplateHaskell #-}
import Data.Aeson.TH
data Person = Person {
foo :: String,
bar :: String
} deriving (Eq, Show)
$(deriveJSON defaultOptions ''Person)
As mentioned in the mailing list, you can customize the field names by overriding the fieldLabelModifier function of the defaultOptions record, for example this will change the JSON name of foo to Foo:
$(deriveFromJSON defaultOptions {
fieldLabelModifier = let f "foo" = "Foo"
f other = other
in f
} ''Person)
Do you have any control of the instance being generated? If so, don't emit keys starting with capital letters.
If not: Just define the instance yourself instead of deriving it. It's just a couple lines of code.
This code won't compile.
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data A = A { _a1 :: B, _a2 :: Int }
makeLenses ''A
data B = B1 { _b1 :: Int } | B2
makeLenses ''B
The error is amy.hs:5:21: Not in scope: type constructor or class ‘B’. I have two questions.
Is there a way to do something like this, or do I need to write my own lenses for B?
Given an A, I would like to apply a function to the b1 field, if that field exists. I think this is a job for prisms, but I haven't figured out how to do it.
Rearrange your program as follows
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data A = A { _a1 :: B, _a2 :: Int }
data B = B1 { _b1 :: Int } | B2
makeLenses ''A
makeLenses ''B
The issue has to do with staging order of Template Haskell (and in this case it's possibly a bug).
Observe that makeLenses ''B creates a Traversal for the _b1 field because it only appears in one of the two constructors.
b1 :: Traversal' B Int
If you were to use Prisms, as well, you'd add
makePrisms ''B
which would produce
_B1 :: Prism' B Int
_B2 :: Prism' B ()
I'm trying to avoid writing definitions for toJSON. This is the error I encounter:
Datatypes.hs:92:10:
No instance for (aeson-0.6.0.2:Data.Aeson.Types.Class.GToJSON
(GHC.Generics.Rep (HashMap Key Project)))
arising from a use of `aeson-0.6.0.2:Data.Aeson.Types.Class.$gdmtoJSON'
Possible fix:
add an instance declaration for
(aeson-0.6.0.2:Data.Aeson.Types.Class.GToJSON
(GHC.Generics.Rep (HashMap Key Project)))
In the expression:
(aeson-0.6.0.2:Data.Aeson.Types.Class.$gdmtoJSON)
In an equation for `toJSON':
toJSON = (aeson-0.6.0.2:Data.Aeson.Types.Class.$gdmtoJSON)
In the instance declaration for `ToJSON (HashMap Key Project)'
I get similar errors for all my HashMap data declarations.
Here's the relevant code. Let me know if there is missing information.
{-# LANGUAGE DeriveGeneric #-} -- for JTask and Fields ToJSON instances:w!
{-# LANGUAGE DeriveDataTypeable #-} -- This may be needed for HashMaps
{-# LANGUAGE FlexibleInstances #-} -- for the HashMap ToJSON instances
{-# LANGUAGE DefaultSignatures #-}
import Prelude
import Data.ByteString
import GHC.Generics (Generic )
import Data.Data
import Data.Typeable (Typeable) -- fix HashMap ToJSON instances? maybe
import Data.Aeson
import Data.Aeson.Generic
import Data.Aeson.Types -- (ToJSON,FromJSON)
import Data.HashMap.Strict (HashMap)
data JTask = JTask {fields :: Fields} deriving (Typeable,Data,Generic)
data Fields = Fields { project :: HashMap Key Project
, summary :: ByteString
, issuetype :: HashMap Name Task
, versions :: [HashMap Name Version]
, description :: ByteString
} deriving (Typeable,Data,Generic)
data Key = Key deriving (Typeable,Data,Generic)
instance Show Key where
show Key = "key"
data Name = Name deriving (Typeable,Data,Generic)
instance Show Name where
show Name = "name"
data Task = Task deriving (Typeable,Data,Generic)
type Version = ByteString -- Placeholder type. Probably using Day for realsies.
data Project = BNAP deriving (Typeable,Data,Generic) -- Fill this out as we go
instance Generic (HashMap Key Project)
instance Data (HashMap Key Project)
--instance GToJSON (HashMap Key Project)
instance Generic (HashMap Name ByteString)
instance Data (HashMap Name ByteString)
instance Generic (HashMap Name Task)
instance Data (HashMap Name Task)
-- JSON instances
instance ToJSON CreateError
instance ToJSON Fields
instance ToJSON JTask
instance ToJSON Key
instance ToJSON Name
instance ToJSON Task
instance ToJSON Project
instance ToJSON (HashMap Key Project)
instance ToJSON (HashMap Name Task)
instance ToJSON (HashMap Name ByteString)
-- instance ToJSON Version uncomment when we change Version's type.
I cannot make an instance for Data.Aeson.Types.Class.GToJSON because Data.Aeson.Types.Class
is not exported. What are my options? What will I have to write manually? Is deriveJSON the best choice?
Update:
I implemented the suggestion below.
Here's the code
createObject :: CreateConf -> ResourceT IO Value
createObject (CreateConf iSummary iDesc dd) = do
let jfields = Fields {project = singleton Key BNAP
,summary = iSummary
,issuetype = singleton Name Task
,versions = [singleton Name (calcVersion dd)]
,description = iDesc
}
return $ toJSON (JTask jfields)
The first instance yields Object fromList [("key",Array (fromList []))])
Second instance yields Object fromList [("name",Array (fromList []))]
any idea why name and key are empty?
How could I find out?
Would it be easier to just use deriveJSON.
update:
Thanks to help from NathanHowell the more important problem has been solved, which is the GToJSON instance for unary types. The solution was to make my own instances for the unary types. The JSON objects are out of order, but I don't know if that matters. If it does, it seems another manual ToJSON instance for Fields would fix that.
update:
Okay a little context. I'm writing a JIRA front-end. I mention that because people in the future may come here to discover the following good news: JIRA doesn't care about Object order.
Aeson provides a ToJSON instance for HashMap String a. The easiest way to get things working is to use this instance by converting the HashMap keys to Strings. Just a touch of boilerplate and it uses the Generic instances for everything else.
{-# LANGUAGE DeriveGeneric #-} -- for JTask and Fields ToJSON instances:w!
{-# LANGUAGE FlexibleInstances #-} -- for the HashMap ToJSON instances
{-# LANGUAGE DefaultSignatures #-}
import Prelude
import Data.ByteString
import GHC.Generics (Generic )
import Data.Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
data JTask = JTask {fields :: Fields} deriving (Generic)
data Fields = Fields { project :: HashMap Key Project
, summary :: ByteString
, issuetype :: HashMap Name Task
, versions :: [HashMap Name Version]
, description :: ByteString
} deriving (Generic)
data Key = Key deriving (Generic)
instance Show Key where
show Key = "key"
data Name = Name deriving (Generic)
instance Show Name where
show Name = "name"
data Task = Task deriving (Generic)
type Version = ByteString -- Placeholder type. Probably using Day for realsies.
data Project = BNAP deriving (Generic) -- Fill this out as we go
instance ToJSON Fields
instance ToJSON JTask
instance ToJSON Key
instance ToJSON Name
instance ToJSON Task
instance ToJSON Project
mapfst :: (a -> b) -> [(a, v)] -> [(b, v)]
mapfst f = fmap $ \ (k, v) -> (f k, v)
instance ToJSON a => ToJSON (HashMap Key a) where
toJSON = toJSON . HashMap.fromList . mapfst show . HashMap.toList
instance ToJSON a => ToJSON (HashMap Name a) where
toJSON = toJSON . HashMap.fromList . mapfst show . HashMap.toList
Thanks to newtype and the GeneralizedNewtypeDeriving extension, one can define distinct lightweight types with little effort:
newtype PersonId = PersonId Int deriving (Eq, Ord, Show, NFData, ...)
newtype GroupId = GroupId Int deriving (Eq, Ord, Show, NFData, ...)
which allows the type-system to make sure a PersonId is not used by accident where a GroupId was expected, but still inherit selected typeclass instances from Int.
Now one could simply define PersonIdSet and GroupIdSet as
import Data.Set (Set)
import qualified Data.Set as Set
type PersonIdSet = Set PersonId
type GroupIdSet = Set GroupId
noGroups :: GroupIdSet
noGroups = Set.empty
-- should not type-check
foo = PersonId 123 `Set.member` noGroups
-- should type-check
bar = GroupId 123 `Set.member` noGroups
which is type safe, since map is parametrized by the key-type, and also, the Set.member operation is polymorphic so I don't need to define per-id-type variants such as personIdSetMember and groupIdSetMember (and all other set-operations I might want to use)
...but how can I use the more efficient IntSets instead for PersonIdSet and GroupIdSet respectively in a similiar way to the example above? Is there a simple way w/o having to wrap/replicate the whole Data.IntSet API as a typeclass?
I think you have to wrap IntSet as you said. However, rather than defining each ID type separately, you can introduce a phantom type to create a family of IDs and IDSets that are compatible with one another:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)
newtype ID a = ID { unID :: Int }
deriving ( Eq, Ord, Show, Num )
newtype IDSet a = IDSet { unIDSet :: IntSet }
deriving ( Eq, Ord, Show )
null :: IDSet a -> Bool
null = IntSet.null . unIDSet
member :: ID a -> IDSet a -> Bool
member i = IntSet.member (unID i) . unIDSet
empty :: IDSet a
empty = IDSet $ IntSet.empty
singleton :: ID a -> IDSet a
singleton = IDSet . IntSet.singleton . unID
insert :: ID a -> IDSet a -> IDSet a
insert i = IDSet . IntSet.insert (unID i) . unIDSet
delete :: ID a -> IDSet a -> IDSet a
delete i = IDSet . IntSet.delete (unID i) . unIDSet
So, assuming you have a Person type, and a Group type, you can do:
type PersonID = ID Person
type PersonIDSet = IDSet Person
type GroupID = ID Group
type GroupIDSet = IDSet Group
The enummapset package implements one approach to newtype-safe IntMap/IntSets.
An example for its usage based on the types from the original question:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Data.EnumSet (EnumSet)
import qualified Data.EnumSet as ES
newtype PersonId = PersonId Int deriving Enum
newtype GroupId = GroupId Int deriving Enum
type PersonIdSet = EnumSet PersonId
type GroupIdSet = EnumSet GroupId
noGroups :: GroupIdSet
noGroups = ES.empty
-- fails type-check: Couldn't match expected type `PersonId' with actual type `GroupId'
foo = PersonId 123 `ES.member` noGroups
-- passes type-check
bar = GroupId 123 `ES.member` noGroups
The usage of Data.EnumMap is similar.
I am under the impression you assume it is less efficient to use a type instead of a newtype. That is not true, newtypes are usually more efficiently implemented than datas.
So, your definition of PersonIdSet is perfectly safe and as efficient as you might want.