bd4175d1-f249-4c7e-b1a7-608a150c31cb

Committed 13 Jun 2025 05:02PM UTC coverage: 32.165%. Remained the same

Build # bd4175d1-f249-4c7e-b1a7-608a150c31cb

Build Type

push

circleci

Committed by

web-flow

Commit Message

Refactored Graph functions into new Models.Graph module (#1566)

Run Details

21 of 140 branches covered (15.0%)

Branch coverage included in aggregate %.

0 of 50 new or added lines in 2 files covered. (0.0%)

5 existing lines in 1 file now uncovered.

640 of 1915 relevant lines covered (33.42%)

26.37 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/app/Models/Graph.hs

module Models.Graph
    (getGraph,
    insertGraph) where

import Config (runDb)
import Data.Aeson (Value, object, toJSON)
import Data.List (partition)
import qualified Data.Text as T (Text)
import Database.DataType (ShapeType (BoolNode, Hybrid, Node))
import Database.Persist.Sqlite (Entity, PersistEntity, PersistValue (PersistInt64), SqlPersistM,
                                entityKey, entityVal, insert, insertMany_, keyToValues, selectFirst,
                                selectList, (<-.), (==.))
import Database.Tables hiding (paths, shapes, texts)
import Svg.Builder (buildEllipses, buildPath, buildRect, intersectsWithShape)

getGraph :: T.Text -> IO (Maybe Value)
getGraph graphName = runDb $ do
    graphEnt :: (Maybe (Entity Graph)) <- selectFirst [GraphTitle ==. graphName] []
    case graphEnt of
        Nothing -> return Nothing
        Just graph -> do
            let gId = entityKey graph
            sqlTexts    :: [Entity Text] <- selectList [TextGraph ==. gId] []
            sqlRects    :: [Entity Shape] <- selectList
                                                 [ShapeType_ <-. [Node, Hybrid],
                                                  ShapeGraph ==. gId] []
            sqlEllipses :: [Entity Shape] <- selectList
                                                 [ShapeType_ ==. BoolNode,
                                                  ShapeGraph ==. gId] []
            sqlPaths    :: [Entity Path] <- selectList [PathGraph ==. gId] []

            let
                keyAsInt :: PersistEntity a => Entity a -> Integer
                keyAsInt = fromIntegral . (\(PersistInt64 x) -> x) . head . keyToValues . entityKey

                graphtexts          = map entityVal sqlTexts
                rects          = zipWith (buildRect graphtexts)
                                         (map entityVal sqlRects)
                                         (map keyAsInt sqlRects)
                ellipses       = zipWith (buildEllipses graphtexts)
                                         (map entityVal sqlEllipses)
                                         (map keyAsInt sqlEllipses)
                graphpaths     = zipWith (buildPath rects ellipses)
                                         (map entityVal sqlPaths)
                                         (map keyAsInt sqlPaths)
                (regions, _)   = partition pathIsRegion graphpaths
                regionTexts    = filter (not .
                                         intersectsWithShape (rects ++ ellipses))
                                        graphtexts

                response = object [
                        ("texts", toJSON $ graphtexts ++ regionTexts),
                        ("shapes", toJSON $ rects ++ ellipses),
                        ("paths", toJSON $ graphpaths ++ regions),
                        ("width", toJSON $ graphWidth $ entityVal graph),
                        ("height", toJSON $ graphHeight $ entityVal graph)
                    ]

            return (Just response)

insertGraph :: T.Text -> SvgJSON -> SqlPersistM ()
insertGraph nameStr_ (SvgJSON texts shapes paths) = do
    gId <- insert $ Graph nameStr_ 256 256 False
    insertMany_ $ map (\text -> text {textGraph = gId}) texts
    insertMany_ $ map (\shape -> shape {shapeGraph = gId}) shapes
    insertMany_ $ map (\path -> path {pathGraph = gId}) paths

1	module Models.Graph
2	(getGraph,
3	insertGraph) where
4
5	import Config (runDb)
6	import Data.Aeson (Value, object, toJSON)
7	import Data.List (partition)
8	import qualified Data.Text as T (Text)
9	import Database.DataType (ShapeType (BoolNode, Hybrid, Node))
10	import Database.Persist.Sqlite (Entity, PersistEntity, PersistValue (PersistInt64), SqlPersistM,
11	entityKey, entityVal, insert, insertMany_, keyToValues, selectFirst,
12	selectList, (<-.), (==.))
13	import Database.Tables hiding (paths, shapes, texts)
14	import Svg.Builder (buildEllipses, buildPath, buildRect, intersectsWithShape)
15
16	getGraph :: T.Text -> IO (Maybe Value)
NEW 17	getGraph graphName = runDb $ do	×
NEW 18	graphEnt :: (Maybe (Entity Graph)) <- selectFirst [GraphTitle ==. graphName] []	×
NEW 19	case graphEnt of	×
NEW 20	Nothing -> return Nothing	×
NEW 21	Just graph -> do	×
NEW 22	let gId = entityKey graph	×
NEW 23	sqlTexts :: [Entity Text] <- selectList [TextGraph ==. gId] []	×
NEW 24	sqlRects :: [Entity Shape] <- selectList	×
NEW 25	[ShapeType_ <-. [Node, Hybrid],	×
NEW 26	ShapeGraph ==. gId] []	×
NEW 27	sqlEllipses :: [Entity Shape] <- selectList	×
NEW 28	[ShapeType_ ==. BoolNode,	×
NEW 29	ShapeGraph ==. gId] []	×
NEW 30	sqlPaths :: [Entity Path] <- selectList [PathGraph ==. gId] []	×
31
32	let
33	keyAsInt :: PersistEntity a => Entity a -> Integer
NEW 34	keyAsInt = fromIntegral . (\(PersistInt64 x) -> x) . head . keyToValues . entityKey	×
35
NEW 36	graphtexts = map entityVal sqlTexts	×
NEW 37	rects = zipWith (buildRect graphtexts)	×
NEW 38	(map entityVal sqlRects)	×
NEW 39	(map keyAsInt sqlRects)	×
NEW 40	ellipses = zipWith (buildEllipses graphtexts)	×
NEW 41	(map entityVal sqlEllipses)	×
NEW 42	(map keyAsInt sqlEllipses)	×
NEW 43	graphpaths = zipWith (buildPath rects ellipses)	×
NEW 44	(map entityVal sqlPaths)	×
NEW 45	(map keyAsInt sqlPaths)	×
NEW 46	(regions, _) = partition pathIsRegion graphpaths	×
NEW 47	regionTexts = filter (not .	×
NEW 48	intersectsWithShape (rects ++ ellipses))	×
NEW 49	graphtexts	×
50
NEW 51	response = object [	×
NEW 52	("texts", toJSON $ graphtexts ++ regionTexts),	×
NEW 53	("shapes", toJSON $ rects ++ ellipses),	×
NEW 54	("paths", toJSON $ graphpaths ++ regions),	×
NEW 55	("width", toJSON $ graphWidth $ entityVal graph),	×
NEW 56	("height", toJSON $ graphHeight $ entityVal graph)	×
57	]
58
NEW 59	return (Just response)	×
60
61	insertGraph :: T.Text -> SvgJSON -> SqlPersistM ()
NEW 62	insertGraph nameStr_ (SvgJSON texts shapes paths) = do	×
NEW 63	gId <- insert $ Graph nameStr_ 256 256 False	×
NEW 64	insertMany_ $ map (\text -> text {textGraph = gId}) texts	×
NEW 65	insertMany_ $ map (\shape -> shape {shapeGraph = gId}) shapes	×
NEW 66	insertMany_ $ map (\path -> path {pathGraph = gId}) paths	×

Courseography / courseography / bd4175d1-f249-4c7e-b1a7-608a150c31cb

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous