-- | The data type definition for "Futhark.Analysis.Metrics", factored
-- out to simplify the module import hierarchies when working on the
-- test modules.
module Futhark.Analysis.Metrics.Type (AstMetrics (..)) where

import Data.Map.Strict qualified as M
import Data.Text (Text)
import Data.Text qualified as T

-- | AST metrics are simply a collection from identifiable node names
-- to the number of times that node appears.
newtype AstMetrics = AstMetrics (M.Map Text Int)

instance Show AstMetrics where
  show :: AstMetrics -> String
show (AstMetrics Map Text Int
m) = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (Text, a) -> String
metric forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text Int
m
    where
      metric :: (Text, a) -> String
metric (Text
k, a
v) = Text -> String
T.unpack Text
k forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v

instance Read AstMetrics where
  readsPrec :: Int -> ReadS AstMetrics
readsPrec Int
_ String
s =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall {b}. IsString b => [(Text, Int)] -> [(AstMetrics, b)]
success forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {b}. Read b => String -> Maybe (Text, b)
onLine forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s
    where
      onLine :: String -> Maybe (Text, b)
onLine String
l = case String -> [String]
words String
l of
        [String
k, String
x] | [(b
n, String
"")] <- forall a. Read a => ReadS a
reads String
x -> forall a. a -> Maybe a
Just (String -> Text
T.pack String
k, b
n)
        [String]
_ -> forall a. Maybe a
Nothing
      success :: [(Text, Int)] -> [(AstMetrics, b)]
success [(Text, Int)]
m = [(Map Text Int -> AstMetrics
AstMetrics forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Int)]
m, b
"")]