{-# LANGUAGE GADTs #-}

{- | Report views, the @{...}@ keys of a report template, as data. A view's
'Spec' says how its key is spelled and what it reads (numbers, a format);
parsing a key against it yields that value, typed, and the renderer takes
it. Usage text, the docs table and key matching all read the same 'Spec'.

The shared views live in "Wrench.Report", each ISA's own in
'Wrench.Machine.Types.views'. A report template is compiled against them
once, before the simulation runs, so rendering cannot meet a bad key.
-}
module Wrench.Report.View (
    -- * Key specs
    Spec,
    Format (..),
    lit,
    arg,
    optArg,
    format,
    formatRequired,
    usage,
    specName,

    -- * Views
    CheckEnv (..),
    View (..),
    mkView,
    checkedView,
    withRenames,
    contramapView,
    viewUsage,
    viewName,
    viewsTable,
    renamesTable,
    Stat (..),
    statView,

    -- * Templates
    Template,
    compileTemplate,
    renderTemplate,
    examples,
) where

import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Relude

data Format = Dec | Hex | Sym | Bin
    deriving (Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
$cminBound :: Format
minBound :: Format
$cmaxBound :: Format
maxBound :: Format
Bounded, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
(Format -> Format)
-> (Format -> Format)
-> (Int -> Format)
-> (Format -> Int)
-> (Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> Format -> [Format])
-> Enum Format
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Format -> Format
succ :: Format -> Format
$cpred :: Format -> Format
pred :: Format -> Format
$ctoEnum :: Int -> Format
toEnum :: Int -> Format
$cfromEnum :: Format -> Int
fromEnum :: Format -> Int
$cenumFrom :: Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromThenTo :: Format -> Format -> Format -> [Format]
Enum, Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Int -> Format -> [Char] -> [Char]
[Format] -> [Char] -> [Char]
Format -> [Char]
(Int -> Format -> [Char] -> [Char])
-> (Format -> [Char])
-> ([Format] -> [Char] -> [Char])
-> Show Format
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Format -> [Char] -> [Char]
showsPrec :: Int -> Format -> [Char] -> [Char]
$cshow :: Format -> [Char]
show :: Format -> [Char]
$cshowList :: [Format] -> [Char] -> [Char]
showList :: [Format] -> [Char] -> [Char]
Show)

formatName :: Format -> Text
formatName :: Format -> Text
formatName = Text -> Text
T.toLower (Text -> Text) -> (Format -> Text) -> Format -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
forall b a. (Show a, IsString b) => a -> b
show

-- | One colon-separated part of a key.
data Piece a where
    PLit :: Text -> Piece ()
    -- | A number, decimal or @0x@ hex, named for messages.
    PArg :: Text -> Piece Int
    POptArg :: Text -> Piece (Maybe Int)
    -- | Allowed formats and the default; 'Nothing' makes it required.
    PFormat :: NonEmpty Format -> Maybe Format -> Piece Format

-- | How a key is spelled, and what it reads: a free applicative over its
-- parts, so it can be both parsed and inspected (for usage and docs).
data Spec a where
    Done :: a -> Spec a
    Step :: Piece b -> Spec (b -> a) -> Spec a

instance Functor Spec where
    fmap :: forall a b. (a -> b) -> Spec a -> Spec b
fmap a -> b
f (Done a
a) = b -> Spec b
forall a. a -> Spec a
Done (a -> b
f a
a)
    fmap a -> b
f (Step Piece b
p Spec (b -> a)
rest) = Piece b -> Spec (b -> b) -> Spec b
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step Piece b
p (((b -> a) -> b -> b) -> Spec (b -> a) -> Spec (b -> b)
forall a b. (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Spec (b -> a)
rest)

instance Applicative Spec where
    pure :: forall a. a -> Spec a
pure = a -> Spec a
forall a. a -> Spec a
Done
    Done a -> b
f <*> :: forall a b. Spec (a -> b) -> Spec a -> Spec b
<*> Spec a
x = (a -> b) -> Spec a -> Spec b
forall a b. (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Spec a
x
    Step Piece b
p Spec (b -> a -> b)
rest <*> Spec a
x = Piece b -> Spec (b -> b) -> Spec b
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step Piece b
p ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> a -> b) -> a -> b -> b)
-> Spec (b -> a -> b) -> Spec (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Spec (b -> a -> b)
rest Spec (a -> b -> b) -> Spec a -> Spec (b -> b)
forall a b. Spec (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Spec a
x)

-- | Literal parts: @lit "mem:instr-ranges"@ is two of them.
lit :: Text -> Spec ()
lit :: Text -> Spec ()
lit Text
name = (Text -> Spec ()) -> [Text] -> Spec ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\Text
t -> Piece () -> Spec (() -> ()) -> Spec ()
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step (Text -> Piece ()
PLit Text
t) ((() -> ()) -> Spec (() -> ())
forall a. a -> Spec a
Done () -> ()
forall a. a -> a
id)) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
name)

arg :: Text -> Spec Int
arg :: Text -> Spec Int
arg Text
name = Piece Int -> Spec (Int -> Int) -> Spec Int
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step (Text -> Piece Int
PArg Text
name) ((Int -> Int) -> Spec (Int -> Int)
forall a. a -> Spec a
Done Int -> Int
forall a. a -> a
id)

optArg :: Text -> Spec (Maybe Int)
optArg :: Text -> Spec (Maybe Int)
optArg Text
name = Piece (Maybe Int)
-> Spec (Maybe Int -> Maybe Int) -> Spec (Maybe Int)
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step (Text -> Piece (Maybe Int)
POptArg Text
name) ((Maybe Int -> Maybe Int) -> Spec (Maybe Int -> Maybe Int)
forall a. a -> Spec a
Done Maybe Int -> Maybe Int
forall a. a -> a
id)

format :: [Format] -> Format -> Spec Format
format :: [Format] -> Format -> Spec Format
format [Format]
fs Format
def = Piece Format -> Spec (Format -> Format) -> Spec Format
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step (NonEmpty Format -> Maybe Format -> Piece Format
PFormat ([Format] -> NonEmpty Format
nonEmptyFormats [Format]
fs) (Format -> Maybe Format
forall a. a -> Maybe a
Just Format
def)) ((Format -> Format) -> Spec (Format -> Format)
forall a. a -> Spec a
Done Format -> Format
forall a. a -> a
id)

formatRequired :: [Format] -> Spec Format
formatRequired :: [Format] -> Spec Format
formatRequired [Format]
fs = Piece Format -> Spec (Format -> Format) -> Spec Format
forall b a. Piece b -> Spec (b -> a) -> Spec a
Step (NonEmpty Format -> Maybe Format -> Piece Format
PFormat ([Format] -> NonEmpty Format
nonEmptyFormats [Format]
fs) Maybe Format
forall a. Maybe a
Nothing) ((Format -> Format) -> Spec (Format -> Format)
forall a. a -> Spec a
Done Format -> Format
forall a. a -> a
id)

nonEmptyFormats :: [Format] -> NonEmpty Format
nonEmptyFormats :: [Format] -> NonEmpty Format
nonEmptyFormats = NonEmpty Format -> Maybe (NonEmpty Format) -> NonEmpty Format
forall a. a -> Maybe a -> a
fromMaybe (Text -> NonEmpty Format
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"a format piece needs at least one format") (Maybe (NonEmpty Format) -> NonEmpty Format)
-> ([Format] -> Maybe (NonEmpty Format))
-> [Format]
-> NonEmpty Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Format] -> Maybe (NonEmpty Format)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty

data SomePiece = forall a. SomePiece (Piece a)

pieces :: Spec a -> [SomePiece]
pieces :: forall a. Spec a -> [SomePiece]
pieces (Done a
_) = []
pieces (Step Piece b
p Spec (b -> a)
rest) = Piece b -> SomePiece
forall a. Piece a -> SomePiece
SomePiece Piece b
p SomePiece -> [SomePiece] -> [SomePiece]
forall a. a -> [a] -> [a]
: Spec (b -> a) -> [SomePiece]
forall a. Spec a -> [SomePiece]
pieces Spec (b -> a)
rest

-- | The literal part of a key: @mem:table@, @mem:dump@, @pc@.
specName :: Spec a -> Text
specName :: forall a. Spec a -> Text
specName = Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> (Spec a -> [Text]) -> Spec a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec a -> [Text]
forall a. Spec a -> [Text]
literals

literals :: Spec a -> [Text]
literals :: forall a. Spec a -> [Text]
literals Spec a
spec = [Text
t | SomePiece (PLit Text
t) <- (SomePiece -> Bool) -> [SomePiece] -> [SomePiece]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile SomePiece -> Bool
isLit (Spec a -> [SomePiece]
forall a. Spec a -> [SomePiece]
pieces Spec a
spec)]
    where
        isLit :: SomePiece -> Bool
isLit (SomePiece (PLit Text
_)) = Bool
True
        isLit SomePiece
_ = Bool
False

usage :: Spec a -> Text
usage :: forall a. Spec a -> Text
usage Spec a
spec = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Int -> SomePiece -> Text) -> [Int] -> [SomePiece] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> SomePiece -> Text
render [Int
0 :: Int ..] (Spec a -> [SomePiece]
forall a. Spec a -> [SomePiece]
pieces Spec a
spec)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
    where
        sep :: a -> a
sep a
n = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
"" else a
":"
        render :: Int -> SomePiece -> Text
        render :: Int -> SomePiece -> Text
render Int
n (SomePiece Piece a
p) = case Piece a
p of
            PLit Text
t -> Int -> Text
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
sep Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
            PArg Text
a -> Int -> Text
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
sep Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
            POptArg Text
a -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
sep Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">]"
            PFormat NonEmpty Format
fs Maybe Format
Nothing -> Int -> Text
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
sep Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Format -> Text
formats NonEmpty Format
fs
            PFormat NonEmpty Format
fs (Just Format
_) -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a} {a}. (Eq a, Num a, IsString a) => a -> a
sep Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Format -> Text
formats NonEmpty Format
fs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
        formats :: NonEmpty Format -> Text
        formats :: NonEmpty Format -> Text
formats = Text -> [Text] -> Text
T.intercalate Text
"|" ([Text] -> Text)
-> (NonEmpty Format -> [Text]) -> NonEmpty Format -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> Text) -> [Format] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Format -> Text
formatName ([Format] -> [Text])
-> (NonEmpty Format -> [Format]) -> NonEmpty Format -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Format -> [Format]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Read a key's parts, left to right.
parseSpec :: Spec a -> [Text] -> Either Text a
parseSpec :: forall a. Spec a -> [Text] -> Either Text a
parseSpec (Done a
a) [] = a -> Either Text a
forall a b. b -> Either a b
Right a
a
parseSpec (Done a
_) [Text]
extra = Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"unexpected '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" [Text]
extra Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
parseSpec (Step Piece b
p Spec (b -> a)
rest) [Text]
parts = case Piece b -> [Text] -> Either Text (b, [Text])
forall a. Piece a -> [Text] -> Either Text (a, [Text])
parsePiece Piece b
p [Text]
parts of
    Right (b
b, [Text]
parts') -> ((b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
$ b
b) ((b -> a) -> a) -> Either Text (b -> a) -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Spec (b -> a) -> [Text] -> Either Text (b -> a)
forall a. Spec a -> [Text] -> Either Text a
parseSpec Spec (b -> a)
rest [Text]
parts'
    -- An optional format that does not match may be left out: the part is
    -- then the next piece's (@stack:layout:3@). If that fails too, the format
    -- error is the one to report.
    Left Text
err
        | PFormat NonEmpty Format
_ (Just Format
def) <- Piece b
p
        , Bool -> Bool
not ([SomePiece] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Spec (b -> a) -> [SomePiece]
forall a. Spec a -> [SomePiece]
pieces Spec (b -> a)
rest)) ->
            (Text -> Text) -> Either Text a -> Either Text a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> Text
forall a b. a -> b -> a
const Text
err) (((Format -> a) -> Format -> a
forall a b. (a -> b) -> a -> b
$ Format
def) ((Format -> a) -> a) -> Either Text (Format -> a) -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Spec (Format -> a) -> [Text] -> Either Text (Format -> a)
forall a. Spec a -> [Text] -> Either Text a
parseSpec Spec (b -> a)
Spec (Format -> a)
rest [Text]
parts)
        | Bool
otherwise -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
err

parsePiece :: Piece a -> [Text] -> Either Text (a, [Text])
parsePiece :: forall a. Piece a -> [Text] -> Either Text (a, [Text])
parsePiece Piece a
p [Text]
parts = case (Piece a
p, [Text]
parts) of
    (PLit Text
t, Text
x : [Text]
xs) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x -> (a, [Text]) -> Either Text (a, [Text])
forall a b. b -> Either a b
Right ((), [Text]
xs)
    (PLit Text
t, [Text]
_) -> Text -> Either Text (a, [Text])
forall a b. a -> Either a b
Left (Text -> Either Text (a, [Text]))
-> Text -> Either Text (a, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"expected '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
    (PArg Text
a, []) -> Text -> Either Text (a, [Text])
forall a b. a -> Either a b
Left (Text -> Either Text (a, [Text]))
-> Text -> Either Text (a, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"missing <" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
    (PArg Text
a, Text
x : [Text]
xs) -> (,[Text]
xs) (a -> (a, [Text])) -> Either Text a -> Either Text (a, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Either Text a
forall {a} {r}.
(Semigroup a, IsString a, Read r, ToString a) =>
a -> a -> Either a r
number Text
a Text
x
    (POptArg Text
_, []) -> (a, [Text]) -> Either Text (a, [Text])
forall a b. b -> Either a b
Right (a
Maybe Int
forall a. Maybe a
Nothing, [])
    (POptArg Text
a, Text
x : [Text]
xs) -> (,[Text]
xs) (a -> (a, [Text])) -> (Int -> a) -> Int -> (a, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> (a, [Text])) -> Either Text Int -> Either Text (a, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Either Text Int
forall {a} {r}.
(Semigroup a, IsString a, Read r, ToString a) =>
a -> a -> Either a r
number Text
a Text
x
    (PFormat NonEmpty Format
_ (Just Format
f), []) -> (a, [Text]) -> Either Text (a, [Text])
forall a b. b -> Either a b
Right (a
Format
f, [])
    (PFormat NonEmpty Format
fs Maybe Format
Nothing, []) -> Text -> Either Text (a, [Text])
forall a b. a -> Either a b
Left (Text -> Either Text (a, [Text]))
-> Text -> Either Text (a, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"missing format, one of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Format -> Text) -> [Format] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Format -> Text
formatName (NonEmpty Format -> [Format]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Format
fs))
    (PFormat NonEmpty Format
fs Maybe Format
_, Text
x : [Text]
xs) -> case (Format -> Bool) -> NonEmpty Format -> Maybe Format
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x) (Text -> Bool) -> (Format -> Text) -> Format -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
formatName) NonEmpty Format
fs of
        Just Format
f -> (a, [Text]) -> Either Text (a, [Text])
forall a b. b -> Either a b
Right (a
Format
f, [Text]
xs)
        Maybe Format
Nothing -> Text -> Either Text (a, [Text])
forall a b. a -> Either a b
Left (Text -> Either Text (a, [Text]))
-> Text -> Either Text (a, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"unknown format '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"', one of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Format -> Text) -> [Format] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Format -> Text
formatName (NonEmpty Format -> [Format]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Format
fs))
    where
        number :: a -> a -> Either a r
number a
name a
x = a -> Maybe r -> Either a r
forall l r. l -> Maybe r -> Either l r
maybeToRight (a
"<" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"> should be a number, got '" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"'") ([Char] -> Maybe r
forall a. Read a => [Char] -> Maybe a
readMaybe (a -> [Char]
forall a. ToString a => a -> [Char]
toString a
x))

-- | What a key's arguments are checked against: the configuration.
data CheckEnv = CheckEnv
    { CheckEnv -> Int
ceMemorySize :: Int
    , CheckEnv -> [Int]
ceIoPorts :: [Int]
    }

data View env = forall a. View
    { ()
vSpec :: Spec a
    , forall env. View env -> Text
vDoc :: Text
    , ()
vCheck :: CheckEnv -> a -> Either Text ()
    , ()
vRender :: env -> a -> Text
    , forall env. View env -> Maybe [Text]
vRenamedTo :: Maybe [Text]
    }

mkView :: Spec a -> Text -> (env -> a -> Text) -> View env
mkView :: forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView Spec a
spec Text
doc = Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> View env
forall a env.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> View env
checkedView Spec a
spec Text
doc (\CheckEnv
_ a
_ -> () -> Either Text ()
forall a b. b -> Either a b
Right ())

-- | A view whose arguments must also fit the configuration.
checkedView :: Spec a -> Text -> (CheckEnv -> a -> Either Text ()) -> (env -> a -> Text) -> View env
checkedView :: forall a env.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> View env
checkedView Spec a
spec Text
doc CheckEnv -> a -> Either Text ()
check env -> a -> Text
render = Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> Maybe [Text]
-> View env
forall env a.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> Maybe [Text]
-> View env
View Spec a
spec Text
doc CheckEnv -> a -> Either Text ()
check env -> a -> Text
render Maybe [Text]
forall a. Maybe a
Nothing

withRenames :: [(Text, Text)] -> [View env] -> [View env]
withRenames :: forall env. [(Text, Text)] -> [View env] -> [View env]
withRenames [(Text, Text)]
renames [View env]
vs = [View env]
vs [View env] -> [View env] -> [View env]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> View env) -> [(Text, Text)] -> [View env]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> View env
alias [(Text, Text)]
renames
    where
        alias :: (Text, Text) -> View env
alias (Text
old, Text
new) = case (View env -> Bool) -> [View env] -> Maybe (View env)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
new) (Text -> Bool) -> (View env -> Text) -> View env -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View env -> Text
forall env. View env -> Text
viewName) [View env]
vs of
            Just (View Spec a
spec Text
doc CheckEnv -> a -> Either Text ()
check env -> a -> Text
render Maybe [Text]
_) ->
                Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> Maybe [Text]
-> View env
forall env a.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> Maybe [Text]
-> View env
View (Text -> Spec ()
lit Text
old Spec () -> Spec a -> Spec a
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Spec a -> Spec a
forall a. Spec a -> Spec a
dropLiterals Spec a
spec) Text
doc CheckEnv -> a -> Either Text ()
check env -> a -> Text
render ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (Spec a -> [Text]
forall a. Spec a -> [Text]
literals Spec a
spec))
            Maybe (View env)
Nothing -> Text -> View env
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> View env) -> Text -> View env
forall a b. (a -> b) -> a -> b
$ Text
"renamed view not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
new

dropLiterals :: Spec a -> Spec a
dropLiterals :: forall a. Spec a -> Spec a
dropLiterals (Step (PLit Text
_) Spec (b -> a)
rest) = Spec a -> Spec a
forall a. Spec a -> Spec a
dropLiterals (((() -> a) -> a) -> Spec (() -> a) -> Spec a
forall a b. (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> a) -> () -> a
forall a b. (a -> b) -> a -> b
$ ()) Spec (b -> a)
Spec (() -> a)
rest)
dropLiterals Spec a
s = Spec a
s

-- | The same view over a larger environment.
contramapView :: (b -> a) -> View a -> View b
contramapView :: forall b a. (b -> a) -> View a -> View b
contramapView b -> a
f (View Spec a
spec Text
doc CheckEnv -> a -> Either Text ()
check a -> a -> Text
render Maybe [Text]
renamedTo) = Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (b -> a -> Text)
-> Maybe [Text]
-> View b
forall env a.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> Maybe [Text]
-> View env
View Spec a
spec Text
doc CheckEnv -> a -> Either Text ()
check (a -> a -> Text
render (a -> a -> Text) -> (b -> a) -> b -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) Maybe [Text]
renamedTo

viewUsage :: View env -> Text
viewUsage :: forall env. View env -> Text
viewUsage View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec} = Spec a -> Text
forall a. Spec a -> Text
usage Spec a
vSpec

viewName :: View env -> Text
viewName :: forall env. View env -> Text
viewName View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec} = Spec a -> Text
forall a. Spec a -> Text
specName Spec a
vSpec

-- | Find the view a key names, read and check its arguments, and close
-- over them. The view with the longest literal prefix wins, so
-- @stack:layout@ is not read as @stack@ with an unknown format.
matchView :: CheckEnv -> [View env] -> Text -> Either Text (Maybe Text, env -> Text)
matchView :: forall env.
CheckEnv
-> [View env] -> Text -> Either Text (Maybe Text, env -> Text)
matchView CheckEnv
checkEnv [View env]
views Text
key =
    case [View env] -> [[View env]]
forall {env}. [View env] -> [[View env]]
groupByLength [View env]
candidates of
        [] -> Text -> Either Text (Maybe Text, env -> Text)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe Text, env -> Text))
-> Text -> Either Text (Maybe Text, env -> Text)
forall a b. (a -> b) -> a -> b
$ Text
"unknown view {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [View env] -> [Text] -> Text
forall env. [View env] -> [Text] -> Text
suggestions [View env]
views [Text]
parts
        [View env]
best : [[View env]]
_ ->
            let results :: [Either Text (Maybe Text, env -> Text)]
results = (View env -> Either Text (Maybe Text, env -> Text))
-> [View env] -> [Either Text (Maybe Text, env -> Text)]
forall a b. (a -> b) -> [a] -> [b]
map View env -> Either Text (Maybe Text, env -> Text)
try [View env]
best
             in case [Either Text (Maybe Text, env -> Text)]
-> [(Maybe Text, env -> Text)]
forall a b. [Either a b] -> [b]
rights [Either Text (Maybe Text, env -> Text)]
results of
                    (Maybe Text, env -> Text)
hole : [(Maybe Text, env -> Text)]
_ -> (Maybe Text, env -> Text) -> Either Text (Maybe Text, env -> Text)
forall a b. b -> Either a b
Right (Maybe Text, env -> Text)
hole
                    [] -> Text -> Either Text (Maybe Text, env -> Text)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe Text, env -> Text))
-> Text -> Either Text (Maybe Text, env -> Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Either Text (Maybe Text, env -> Text)] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text (Maybe Text, env -> Text)]
results)
    where
        parts :: [Text]
parts = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
key
        prefixLength :: View env -> Int
prefixLength View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec} = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Spec a -> [Text]
forall a. Spec a -> [Text]
literals Spec a
vSpec)
        candidates :: [View env]
candidates =
            (View env -> Down Int) -> [View env] -> [View env]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
                (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int) -> (View env -> Int) -> View env -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View env -> Int
forall {env}. View env -> Int
prefixLength)
                [View env
v | v :: View env
v@View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec} <- [View env]
views, let ls :: [Text]
ls = Spec a -> [Text]
forall a. Spec a -> [Text]
literals Spec a
vSpec, Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls), [Text]
ls [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
parts]
        groupByLength :: [View env] -> [[View env]]
groupByLength [View env]
vs = case [View env]
vs of
            [] -> []
            View env
v : [View env]
_ -> [(View env -> Bool) -> [View env] -> [View env]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== View env -> Int
forall {env}. View env -> Int
prefixLength View env
v) (Int -> Bool) -> (View env -> Int) -> View env -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. View env -> Int
forall {env}. View env -> Int
prefixLength) [View env]
vs]
        try :: View env -> Either Text (Maybe Text, env -> Text)
try View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec, CheckEnv -> a -> Either Text ()
vCheck :: ()
vCheck :: CheckEnv -> a -> Either Text ()
vCheck, env -> a -> Text
vRender :: ()
vRender :: env -> a -> Text
vRender, Maybe [Text]
vRenamedTo :: forall env. View env -> Maybe [Text]
vRenamedTo :: Maybe [Text]
vRenamedTo} =
            (Text -> Text)
-> Either Text (Maybe Text, env -> Text)
-> Either Text (Maybe Text, env -> Text)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Text
err -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", usage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Spec a -> Text
forall a. Spec a -> Text
usage Spec a
vSpec) (Either Text (Maybe Text, env -> Text)
 -> Either Text (Maybe Text, env -> Text))
-> Either Text (Maybe Text, env -> Text)
-> Either Text (Maybe Text, env -> Text)
forall a b. (a -> b) -> a -> b
$ do
                a <- Spec a -> [Text] -> Either Text a
forall a. Spec a -> [Text] -> Either Text a
parseSpec Spec a
vSpec [Text]
parts
                vCheck checkEnv a
                return (renamedWarning (length (literals vSpec)) <$> vRenamedTo, (`vRender` a))
        renamedWarning :: Int -> [Text] -> Text
renamedWarning Int
n [Text]
new =
            Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"} is renamed, use {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" ([Text]
new [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
n [Text]
parts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- | Views whose name is a small edit away from the key's leading parts,
-- compared case-insensitively.
suggestions :: [View env] -> [Text] -> Text
suggestions :: forall env. [View env] -> [Text] -> Text
suggestions [View env]
views [Text]
parts =
    case Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
3 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Text
forall a b. (a, b) -> b
snd ([(Int, Text)] -> [Text]) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Int) -> [(Int, Text)] -> [(Int, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
close of
        [] -> Text
""
        [Text]
us -> Text
", did you mean " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" or " [Text]
us Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"
    where
        close :: [(Int, Text)]
close =
            [ (Int
d, Spec a -> Text
forall a. Spec a -> Text
usage Spec a
vSpec)
            | View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec, vRenamedTo :: forall env. View env -> Maybe [Text]
vRenamedTo = Maybe [Text]
Nothing} <- [View env]
views
            , let ls :: [Text]
ls = Spec a -> [Text]
forall a. Spec a -> [Text]
literals Spec a
vSpec
                  name :: Text
name = Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ls
                  given :: Text
given = Text -> [Text] -> Text
T.intercalate Text
":" (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls) [Text]
parts)
                  d :: Int
d = Text -> Text -> Int
editDistance (Text -> Text
T.toLower Text
name) (Text -> Text
T.toLower Text
given)
            , Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Text -> Int
T.length Text
name Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3)
            ]

editDistance :: Text -> Text -> Int
editDistance :: Text -> Text -> Int
editDistance Text
a Text
b = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (NonEmpty Int -> Int) -> [Int] -> Maybe Int
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Int -> Int
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> Char -> [Int]) -> [Int] -> [Char] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Int] -> Char -> [Int]
step [Int
0 .. Text -> Int
T.length Text
a] (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
b)
    where
        step :: [Int] -> Char -> [Int]
step prev :: [Int]
prev@(Int
p : [Int]
ps) Char
c =
            let row :: [Int]
row = (Int -> (Char, Int, Int) -> Int)
-> Int -> [(Char, Int, Int)] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> (Char, Int, Int) -> Int
compute (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Char] -> [Int] -> [Int] -> [(Char, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
a) [Int]
prev [Int]
ps)
                compute :: Int -> (Char, Int, Int) -> Int
compute Int
left (Char
ca, Int
diag, Int
up) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
up Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Int
diag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Char
ca Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c then Int
0 else Int
1)
             in [Int]
row
        step [] Char
_ = []

-- | Keys that name this view, one per spelling: every format, with and
-- without optional parts, @0@ for each number.
examples :: View env -> [Text]
examples :: forall env. View env -> [Text]
examples View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec} = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text] -> Text
T.intercalate Text
":") ([SomePiece] -> [[Text]]
go (Spec a -> [SomePiece]
forall a. Spec a -> [SomePiece]
pieces Spec a
vSpec))
    where
        go :: [SomePiece] -> [[Text]]
        go :: [SomePiece] -> [[Text]]
go [] = [[]]
        go (SomePiece Piece a
p : [SomePiece]
ps) = [[Text]
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
rest | [Text]
x <- Piece a -> [[Text]]
forall a. Piece a -> [[Text]]
spellings Piece a
p, [Text]
rest <- [SomePiece] -> [[Text]]
go [SomePiece]
ps]
        spellings :: Piece a -> [[Text]]
        spellings :: forall a. Piece a -> [[Text]]
spellings Piece a
p = case Piece a
p of
            PLit Text
t -> [[Text
t]]
            PArg Text
_ -> [[Text
"0"]]
            POptArg Text
_ -> [[], [Text
"0"]]
            PFormat NonEmpty Format
fs Maybe Format
d -> [[] | Maybe Format -> Bool
forall a. Maybe a -> Bool
isJust Maybe Format
d] [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> [[Format -> Text
formatName Format
f] | Format
f <- NonEmpty Format -> [Format]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Format
fs]

-- | A run-wide stat of an ISA: a view of its own and a line of @{isa-specific}@.
data Stat env = Stat
    { forall env. Stat env -> Text
statName :: Text
    , forall env. Stat env -> Text
statDoc :: Text
    , forall env. Stat env -> env -> Text
statRender :: env -> Text
    }

statView :: Stat env -> View env
statView :: forall env. Stat env -> View env
statView Stat{Text
statName :: forall env. Stat env -> Text
statName :: Text
statName, Text
statDoc :: forall env. Stat env -> Text
statDoc :: Text
statDoc, env -> Text
statRender :: forall env. Stat env -> env -> Text
statRender :: env -> Text
statRender} =
    Spec () -> Text -> (env -> () -> Text) -> View env
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView (Text -> Spec ()
lit Text
statName) (Text
statDoc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Listed in `{isa-specific}`.") (\env
env () -> env -> Text
statRender env
env)

-- | A Markdown table of the current views. Neighbours with the same
-- description, such as a register under its two names, share a row.
viewsTable :: [View env] -> Text
viewsTable :: forall env. [View env] -> Text
viewsTable [View env]
vs =
    (Text, Text) -> [(Text, Text)] -> Text
markdownTable
        (Text
"View", Text
"Description")
        [ (Text -> [Text] -> Text
T.intercalate Text
", " [Text -> Text
code (View env -> Text
forall env. View env -> Text
viewUsage View env
v) | View env
v <- NonEmpty (View env) -> [View env]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (View env)
same], Text
vDoc)
        | same :: NonEmpty (View env)
same@(View{Text
vDoc :: forall env. View env -> Text
vDoc :: Text
vDoc} :| [View env]
_) <- (View env -> View env -> Bool)
-> [View env] -> [NonEmpty (View env)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (View env -> Text) -> View env -> View env -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` View env -> Text
forall env. View env -> Text
vDoc) [View env
v | v :: View env
v@View{vRenamedTo :: forall env. View env -> Maybe [Text]
vRenamedTo = Maybe [Text]
Nothing} <- [View env]
vs]
        ]

renamesTable :: [View env] -> Text
renamesTable :: forall env. [View env] -> Text
renamesTable [View env]
vs =
    case [ (Spec a -> Text
forall a. Spec a -> Text
usage Spec a
vSpec, Spec a -> Text
forall a. Spec a -> Text
usage (Text -> Spec ()
lit (Text -> [Text] -> Text
T.intercalate Text
":" [Text]
new) Spec () -> Spec a -> Spec a
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Spec a -> Spec a
forall a. Spec a -> Spec a
dropLiterals Spec a
vSpec))
         | View{Spec a
vSpec :: ()
vSpec :: Spec a
vSpec, vRenamedTo :: forall env. View env -> Maybe [Text]
vRenamedTo = Just [Text]
new} <- [View env]
vs
         ] of
        [] -> Text
""
        [(Text, Text)]
rows -> (Text, Text) -> [(Text, Text)] -> Text
markdownTable (Text
"Old", Text
"New") (((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Text
code Text -> Text
code) [(Text, Text)]
rows)

markdownTable :: (Text, Text) -> [(Text, Text)] -> Text
markdownTable :: (Text, Text) -> [(Text, Text)] -> Text
markdownTable (Text, Text)
header [(Text, Text)]
rows =
    [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
line (Text, Text)
header Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text, Text) -> Text
line (Int -> Text -> Text
T.replicate Int
wA Text
"-", Int -> Text -> Text
T.replicate Int
wB Text
"-") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
line [(Text, Text)]
rows
    where
        wA :: Int
wA = ((Text, Text) -> Int -> Int) -> Int -> [(Text, Text)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> ((Text, Text) -> Int) -> (Text, Text) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) Int
0 ((Text, Text)
header (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rows)
        wB :: Int
wB = ((Text, Text) -> Int -> Int) -> Int -> [(Text, Text)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> ((Text, Text) -> Int) -> (Text, Text) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd) Int
0 ((Text, Text)
header (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rows)
        line :: (Text, Text) -> Text
line (Text
a, Text
b) = Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
wA Char
' ' Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
wB Char
' ' Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"

code :: Text -> Text
code :: Text -> Text
code Text
u = Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|" Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

-- | A report template with every key already matched to its view.
newtype Template env = Template [Chunk env]

data Chunk env = Literal Text | Hole (env -> Text)

-- | Split a template into text and @{key}@ holes, matching every key.
compileTemplate :: CheckEnv -> [View env] -> Text -> Either [Text] ([Text], Template env)
compileTemplate :: forall env.
CheckEnv
-> [View env] -> Text -> Either [Text] ([Text], Template env)
compileTemplate CheckEnv
checkEnv [View env]
views Text
input =
    case [Either Text (Maybe Text, Chunk env)]
-> ([Text], [(Maybe Text, Chunk env)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Either Text Text -> Either Text (Maybe Text, Chunk env))
-> [Either Text Text] -> [Either Text (Maybe Text, Chunk env)]
forall a b. (a -> b) -> [a] -> [b]
map Either Text Text -> Either Text (Maybe Text, Chunk env)
compile (Text -> [Either Text Text]
chunks Text
input)) of
        ([], [(Maybe Text, Chunk env)]
cs) -> ([Text], Template env) -> Either [Text] ([Text], Template env)
forall a b. b -> Either a b
Right (((Maybe Text, Chunk env) -> Maybe Text)
-> [(Maybe Text, Chunk env)] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Text, Chunk env) -> Maybe Text
forall a b. (a, b) -> a
fst [(Maybe Text, Chunk env)]
cs, [Chunk env] -> Template env
forall env. [Chunk env] -> Template env
Template (((Maybe Text, Chunk env) -> Chunk env)
-> [(Maybe Text, Chunk env)] -> [Chunk env]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text, Chunk env) -> Chunk env
forall a b. (a, b) -> b
snd [(Maybe Text, Chunk env)]
cs))
        ([Text]
errs, [(Maybe Text, Chunk env)]
_) -> [Text] -> Either [Text] ([Text], Template env)
forall a b. a -> Either a b
Left [Text]
errs
    where
        compile :: Either Text Text -> Either Text (Maybe Text, Chunk env)
compile (Left Text
t) = (Maybe Text, Chunk env) -> Either Text (Maybe Text, Chunk env)
forall a b. b -> Either a b
Right (Maybe Text
forall a. Maybe a
Nothing, Text -> Chunk env
forall env. Text -> Chunk env
Literal Text
t)
        compile (Right Text
key) = ((env -> Text) -> Chunk env)
-> (Maybe Text, env -> Text) -> (Maybe Text, Chunk env)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (env -> Text) -> Chunk env
forall env. (env -> Text) -> Chunk env
Hole ((Maybe Text, env -> Text) -> (Maybe Text, Chunk env))
-> Either Text (Maybe Text, env -> Text)
-> Either Text (Maybe Text, Chunk env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckEnv
-> [View env] -> Text -> Either Text (Maybe Text, env -> Text)
forall env.
CheckEnv
-> [View env] -> Text -> Either Text (Maybe Text, env -> Text)
matchView CheckEnv
checkEnv [View env]
views Text
key
        -- A '{' without a later '}' is text, as is everything outside braces.
        chunks :: Text -> [Either Text Text]
chunks Text
t
            | Text -> Bool
T.null Text
t = []
            | Bool
otherwise =
                let (Text
before, Text
rest) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"{" Text
t
                    (Text
key, Text
rest') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"}" (Int -> Text -> Text
T.drop Int
1 Text
rest)
                 in if Text -> Bool
T.null Text
rest Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
rest'
                        then [Text -> Either Text Text
forall a b. a -> Either a b
Left Text
t]
                        else [Text -> Either Text Text
forall a b. a -> Either a b
Left Text
before | Bool -> Bool
not (Text -> Bool
T.null Text
before)] [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Either Text Text
forall a b. b -> Either a b
Right Text
key Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: Text -> [Either Text Text]
chunks (Int -> Text -> Text
T.drop Int
1 Text
rest'))

renderTemplate :: Template env -> env -> Text
renderTemplate :: forall env. Template env -> env -> Text
renderTemplate (Template [Chunk env]
cs) env
env = [Text] -> Text
T.concat ((Chunk env -> Text) -> [Chunk env] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Chunk env -> Text
render [Chunk env]
cs)
    where
        render :: Chunk env -> Text
render (Literal Text
t) = Text
t
        render (Hole env -> Text
f) = env -> Text
f env
env