dino-0.1: A convenient tagless EDSL

Safe HaskellNone
LanguageHaskell2010

Dino.AST.Diff

Contents

Synopsis

Documentation

dropEnd :: Int -> [a] -> [a] Source #

Drop elements at the end of a list

Types

data Replace a Source #

Constructors

Replace 

Fields

Instances
Functor Replace Source # 
Instance details

Defined in Dino.AST.Diff

Methods

fmap :: (a -> b) -> Replace a -> Replace b #

(<$) :: a -> Replace b -> Replace a #

Eq a => Eq (Replace a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

(==) :: Replace a -> Replace a -> Bool #

(/=) :: Replace a -> Replace a -> Bool #

Show a => Show (Replace a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

showsPrec :: Int -> Replace a -> ShowS #

show :: Replace a -> String #

showList :: [Replace a] -> ShowS #

Pretty a => Pretty (Replace a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

pretty :: Replace a -> Doc #

prettyList :: [Replace a] -> Doc #

data ElemOp a Source #

Edit operations on an optional element

Constructors

AddElem a 
RemoveElem a 
EditElem (Diff a) 
Instances
(Eq a, Eq (Diff a)) => Eq (ElemOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

(==) :: ElemOp a -> ElemOp a -> Bool #

(/=) :: ElemOp a -> ElemOp a -> Bool #

(Show a, Show (Diff a)) => Show (ElemOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

showsPrec :: Int -> ElemOp a -> ShowS #

show :: ElemOp a -> String #

showList :: [ElemOp a] -> ShowS #

(Pretty a, Pretty (Diff a), Show k, Ord k) => Pretty (Mapping k (ElemOp a)) Source #

If k is a String-like type, it will be shown with quotes. Use Field to prevent this.

Instance details

Defined in Dino.AST.Diff

Methods

pretty :: Mapping k (ElemOp a) -> Doc #

prettyList :: [Mapping k (ElemOp a)] -> Doc #

data EndOp a Source #

Edit operations at the end of a list

Constructors

Append [a] 
DropEnd [a] 
Instances
Functor EndOp Source # 
Instance details

Defined in Dino.AST.Diff

Methods

fmap :: (a -> b) -> EndOp a -> EndOp b #

(<$) :: a -> EndOp b -> EndOp a #

Eq a => Eq (EndOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

(==) :: EndOp a -> EndOp a -> Bool #

(/=) :: EndOp a -> EndOp a -> Bool #

Show a => Show (EndOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

showsPrec :: Int -> EndOp a -> ShowS #

show :: EndOp a -> String #

showList :: [EndOp a] -> ShowS #

data ListOp a Source #

Edit operations on lists

Constructors

ListOp [Maybe (Diff a)] (Maybe (EndOp a)) 
Instances
(Eq a, Eq (Diff a)) => Eq (ListOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

(==) :: ListOp a -> ListOp a -> Bool #

(/=) :: ListOp a -> ListOp a -> Bool #

(Show a, Show (Diff a)) => Show (ListOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

showsPrec :: Int -> ListOp a -> ShowS #

show :: ListOp a -> String #

showList :: [ListOp a] -> ShowS #

(Pretty a, Pretty (Diff a)) => Pretty (ListOp a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

pretty :: ListOp a -> Doc #

prettyList :: [ListOp a] -> Doc #

data Edit a Source #

Edit operation on a AST

Constructors

Replacement (Replace (AST a)) 
EditApp Constr [Maybe (Edit a)] 
EditList (Diff [AST a]) 
EditLet (Diff (Text, AST a, AST a)) 
EditRecord (Diff (Mapping Field (AST a))) 
Instances
Eq a => Eq (Edit a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

(==) :: Edit a -> Edit a -> Bool #

(/=) :: Edit a -> Edit a -> Bool #

Show a => Show (Edit a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

showsPrec :: Int -> Edit a -> ShowS #

show :: Edit a -> String #

showList :: [Edit a] -> ShowS #

Show a => Pretty (Edit a) Source # 
Instance details

Defined in Dino.AST.Diff

Methods

pretty :: Edit a -> Doc #

prettyList :: [Edit a] -> Doc #

newtype Monolithic a Source #

Wrapper for values that should be regarded as monolithic when diffing

Constructors

Monolithic 

Fields

Instances
Eq a => Diffable (Monolithic a) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (Monolithic a) :: Type Source #

type Diff (Monolithic a) Source # 
Instance details

Defined in Dino.AST.Diff

type Diff (Monolithic a) = Replace a

Diffing

class Diffable a where Source #

Minimal complete definition

Nothing

Associated Types

type Diff a Source #

Representation of the difference between two values

Methods

diff Source #

Arguments

:: a

Original

-> a

New

-> Maybe (Diff a) 

Calculate the difference between two values

The result is Nothing iff. the two values are equal.

The following property holds:

If   Just d = diff a b
Then Just b = applyDiff d a

diff Source #

Arguments

:: (Eq a, Diff a ~ Replace a) 
=> a

Original

-> a

New

-> Maybe (Diff a) 

Calculate the difference between two values

The result is Nothing iff. the two values are equal.

The following property holds:

If   Just d = diff a b
Then Just b = applyDiff d a

applyDiff :: Diff a -> a -> Maybe a Source #

Apply an Edit to a Value

This function is mostly intended for testing. It succeeds iff. the edit makes sense.

applyDiff :: (Eq a, Diff a ~ Replace a) => Diff a -> a -> Maybe a Source #

Apply an Edit to a Value

This function is mostly intended for testing. It succeeds iff. the edit makes sense.

Instances
Diffable Bool Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Bool :: Type Source #

Diffable Double Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Double :: Type Source #

Diffable Float Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Float :: Type Source #

Diffable Int Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Int :: Type Source #

Diffable Integer Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Integer :: Type Source #

Diffable Rational Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Rational :: Type Source #

Diffable () Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff () :: Type Source #

Methods

diff :: () -> () -> Maybe (Diff ()) Source #

applyDiff :: Diff () -> () -> Maybe () Source #

Diffable Text Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff Text :: Type Source #

Diffable a => Diffable [a] Source #

Matches element-wise from the start of the lists, and detects additions/removals at the end.

Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff [a] :: Type Source #

Methods

diff :: [a] -> [a] -> Maybe (Diff [a]) Source #

applyDiff :: Diff [a] -> [a] -> Maybe [a] Source #

Diffable a => Diffable (Maybe a) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (Maybe a) :: Type Source #

Methods

diff :: Maybe a -> Maybe a -> Maybe (Diff (Maybe a)) Source #

applyDiff :: Diff (Maybe a) -> Maybe a -> Maybe (Maybe a) Source #

Eq a => Diffable (AST a) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (AST a) :: Type Source #

Methods

diff :: AST a -> AST a -> Maybe (Diff (AST a)) Source #

applyDiff :: Diff (AST a) -> AST a -> Maybe (AST a) Source #

Eq a => Diffable (Monolithic a) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (Monolithic a) :: Type Source #

(Diffable a, Diffable b) => Diffable (a, b) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (a, b) :: Type Source #

Methods

diff :: (a, b) -> (a, b) -> Maybe (Diff (a, b)) Source #

applyDiff :: Diff (a, b) -> (a, b) -> Maybe (a, b) Source #

(Eq k, Hashable k, Diffable a) => Diffable (Mapping k a) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (Mapping k a) :: Type Source #

Methods

diff :: Mapping k a -> Mapping k a -> Maybe (Diff (Mapping k a)) Source #

applyDiff :: Diff (Mapping k a) -> Mapping k a -> Maybe (Mapping k a) Source #

(Diffable a, Diffable b, Diffable c) => Diffable (a, b, c) Source # 
Instance details

Defined in Dino.AST.Diff

Associated Types

type Diff (a, b, c) :: Type Source #

Methods

diff :: (a, b, c) -> (a, b, c) -> Maybe (Diff (a, b, c)) Source #

applyDiff :: Diff (a, b, c) -> (a, b, c) -> Maybe (a, b, c) Source #

applyDiffWhen :: Diffable a => Maybe (Diff a) -> a -> Maybe a Source #

Rendering

prettyEditTuple :: Pretty a => Doc -> Doc -> Doc -> [Maybe a] -> Doc Source #

Pretty print for edits on tuple-like collections (where elements are identified by position)

prettyEditApp :: Pretty a => NameType -> Text -> [Maybe a] -> Doc Source #

Pretty print EditApp for "named" constructors

printEdit :: Show a => Edit a -> IO () Source #

Print an Edit value to the terminal using ANSI colors

diffAsTestResult :: Show a => Maybe (Edit a) -> Doc Source #

Print a diff as a test result

Nothing is shown as a green "OK".

Just d is shown as a red "Fail", followed by a rendering of the diff.