git.iko.soy/project-m36
on master help sign in
WIP: CSV atom type munging
commitb73dd7adf6d02c68973db5082e5ffcc5f53ffe41 authorAgentM <agentm@themactionfaction.com> dateTue 13 Oct 2015, 17:54 (11 years ago) parente723590
4 files changed+30−13
compare with master
unifiedsplit
Database/Persist/ProjectM36.hs+12−7 ProjectM36/Base.hs+1−1 ProjectM36/Client.hs−1 ProjectM36/Relation/Parse/CSV.hs+17−4
Database/Persist/ProjectM36.hs+12−7
@@ -30,6 +30,8 @@ import qualified Database.Persist.Types as DPT
3030import qualified Data.Set as S
3131import qualified Data.Conduit.List as CL
3232import ProjectM36.RelationalExpression (unsafeCast)
33+import Data.Typeable (typeRep, typeOf, Proxy(..))
34+import Data.Time.Calendar (Day)
3335
3436type ProjectM36Backend = C.Connection
3537
@@ -73,12 +75,16 @@ persistValueAtom val = case val of
7375 _ -> Nothing
7476
7577atomAsPersistValue :: Atom -> PersistValue
76−atomAsPersistValue (Atom atom) = map (cast atom) (PersistText, PersistInt64, PersistBool, PersistDay)
77− atom -> PersistText (unsafeCast atom)
78− atom -> PersistInt64 (fromIntegral ((unsafeCast atom)::Int))
79− atom -> PersistBool (unsafeCast atom)
80− atom -> PersistDay (unsafeCast atom)
81− _ -> error "missing conversion"
78+atomAsPersistValue atom@(Atom atomv) = if typeRep (Proxy :: Proxy Int) == typeOf atomv then
79+ PersistInt64 (fromIntegral ((unsafeCast atom) :: Int))
80+ else if typeRep (Proxy :: Proxy T.Text) == typeOf atomv then
81+ PersistText (unsafeCast atom)
82+ else if typeRep (Proxy :: Proxy Bool) == typeOf atomv then
83+ PersistBool (unsafeCast atom)
84+ else if typeRep (Proxy :: Proxy Day) == typeOf atomv then
85+ PersistDay (unsafeCast atom)
86+ else
87+ error "missing conversion"
8288
8389recordAsAtoms :: forall record. (PersistEntity record, PersistEntityBackend record ~ C.Connection)
8490 => Maybe U.UUID -> Attributes -> record -> Either RelationalError (V.Vector Atom)
@@ -506,7 +512,6 @@ instance PersistQuery C.Connection where
506512 Nothing -> Trans.liftIO $ throwIO $ PersistError "failed to get count tuple"
507513 Just tuple -> case atomForAttributeName "persistcount" tuple of
508514 (Right c) -> return (castInt c)
509− Right _ -> Trans.liftIO $ throwIO $ PersistError "count returned wrong data type"
510515 Left err -> left err
511516 case e of
512517 Left err -> throwIOPersistError ("count failure: " ++ show err)
ProjectM36/Base.hs+1−1
@@ -33,7 +33,7 @@ class (Read a,
3333 Show a,
3434 Typeable a,
3535 NFData a) => Atomable a where
36− fromText :: Text -> Either String a
36+ fromText :: (Atomable a) => Text -> Either String a
3737 fromText t = case readMaybe (unpack t) of
3838 Just v -> Right v
3939 Nothing -> Left "parse error"
ProjectM36/Client.hs−1
@@ -21,7 +21,6 @@ module ProjectM36.Client
2121 DatabaseExpr(..),
2222 Attribute(..),
2323 attributesFromList,
24− Attribute,
2524 TransactionGraphOperator(..),
2625 AtomType(..)) where
2726import ProjectM36.Base
ProjectM36/Relation/Parse/CSV.hs+17−4
@@ -17,15 +17,31 @@ import qualified Data.List as L
1717import qualified Data.Text as T
1818import Data.Attoparsec.ByteString.Lazy
1919import Text.Read (readMaybe)
20+import Data.Typeable (typeRep, Proxy(Proxy))
21+import ProjectM36.ConcreteTypeRep
22+import Data.Either (either)
2023
2124data CsvImportError = CsvParseError String |
2225 AttributeMappingError RelationalError |
26+ UnsupportedAtomTypeError AttributeName |
2327 HeaderAttributeMismatchError (S.Set AttributeName)
2428 deriving (Show)
2529
2630csvDecodeOptions :: DecodeOptions
2731csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}
2832
33+makeAtom :: AttributeName -> AtomType -> T.Text -> Either CsvImportError Atom
34+makeAtom attrName (AtomType cTypeRep) strIn = if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then
35+ either (Left . AttributeMappingError . ParseError . T.pack) (Right . Atom) ((fromText strIn) :: Either String Int)
36+ else
37+ Left $ AttributeMappingError (ParseError strIn)
38+ {- where readAtomable :: (Atomable a) => Proxy a -> T.Text -> Either CsvImportError Atom
39+ readAtomable _ strIn' = case fromText strIn of
40+ Right val -> Right $ Atom (val :: a)
41+ Left err -> Left $ AttributeMappingError (ParseError (T.pack err))-}
42+makeAtom attrName _ _ = Left $ UnsupportedAtomTypeError attrName
43+
44+
2945csvAsRelation :: BS.ByteString -> Attributes -> Either CsvImportError Relation
3046csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inString of
3147 Fail _ _ err -> Left (CsvParseError err)
@@ -37,10 +53,7 @@ csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inStr
3753 attrNameSet = S.fromList (V.toList attrNames)
3854 headerSet = S.fromList (V.toList strHeader)
3955 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]
40− makeTupleList tupMap = V.toList $ V.map (\attr -> makeAtom (A.atomType attr) (tupMap HM.! (A.attributeName attr))) attrs
41− makeAtom aType strIn = case readMaybe strIn of
42− Nothing -> Left $ AttributeMappingError (ParseError
43− Right atom -> Right atom
56+ makeTupleList tupMap = V.toList $ V.map (\attr -> makeAtom (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! (A.attributeName attr))) attrs
4457 case attrNameSet == headerSet of
4558 False -> Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)
4659 True -> do