diff options
Diffstat (limited to 'interactive-edit-lens/src/Interact')
-rw-r--r-- | interactive-edit-lens/src/Interact/Types.hs | 120 |
1 files changed, 120 insertions, 0 deletions
diff --git a/interactive-edit-lens/src/Interact/Types.hs b/interactive-edit-lens/src/Interact/Types.hs new file mode 100644 index 0000000..a4d08ac --- /dev/null +++ b/interactive-edit-lens/src/Interact/Types.hs | |||
@@ -0,0 +1,120 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
3 | |||
4 | module Interact.Types | ||
5 | ( InteractName(..) | ||
6 | , _LeftEditor, _RightEditor, _PrimitiveName | ||
7 | , Validity, pattern Valid, pattern Invalid | ||
8 | , InteractState(..) | ||
9 | , HasLeft(..), HasRight(..), HasComplement(..), HasFocus(..), HasFocused(..) | ||
10 | , InteractInitial(..) | ||
11 | , _InitialLeft, _InitialRight, _InitialEmpty | ||
12 | , InteractConfig(..) | ||
13 | , HasInitial(..), HasLens(..), HasCompileError(..) | ||
14 | , InteractEvent | ||
15 | , InteractApp | ||
16 | , InteractDirection(..) | ||
17 | , charseq | ||
18 | , WithName(..) | ||
19 | , module Control.Edit | ||
20 | , module Control.Lens.Edit | ||
21 | , module Control.DFST.Lens | ||
22 | , module Data.Semigroup | ||
23 | , module Numeric.Natural | ||
24 | ) where | ||
25 | |||
26 | import Data.Text (Text) | ||
27 | import qualified Data.Text as Text | ||
28 | import Data.Text.Lens | ||
29 | |||
30 | import Data.Sequence (Seq(..)) | ||
31 | import qualified Data.Sequence as Seq | ||
32 | |||
33 | import qualified Data.Foldable as Foldable | ||
34 | |||
35 | import Data.Semigroup (Semigroup(..), Last(..)) | ||
36 | import Numeric.Natural | ||
37 | |||
38 | import Brick | ||
39 | import Brick.Focus | ||
40 | import Brick.Widgets.Edit | ||
41 | |||
42 | import Control.Lens | ||
43 | import Control.Lens.TH | ||
44 | import Control.Edit | ||
45 | import Control.Lens.Edit | ||
46 | import Control.DFST.Lens | ||
47 | |||
48 | import Data.Text.Zipper.Generic | ||
49 | |||
50 | |||
51 | data InteractName | ||
52 | = LeftEditor | ||
53 | | RightEditor | ||
54 | | PrimitiveName !Text | ||
55 | deriving (Eq, Ord, Show, Read) | ||
56 | |||
57 | makePrisms ''InteractName | ||
58 | |||
59 | type Validity = Bool | ||
60 | pattern Valid = True | ||
61 | pattern Invalid = False | ||
62 | |||
63 | data InteractState c = InteractState | ||
64 | { istLeft, istRight :: (Last Validity, Last (Seq Char, Int), StringEdits Natural Char) | ||
65 | , istComplement :: c | ||
66 | , istFocus :: FocusRing InteractName | ||
67 | } | ||
68 | |||
69 | makeLensesWith abbreviatedFields ''InteractState | ||
70 | |||
71 | class HasFocused s a | s -> a where | ||
72 | focused :: Traversal' s a | ||
73 | |||
74 | instance HasFocused (InteractState c) (Last Validity, Last (Seq Char, Int), StringEdits Natural Char) where | ||
75 | focused f st@InteractState{..} = case focusGetCurrent istFocus of | ||
76 | Just LeftEditor -> left f st | ||
77 | Just RightEditor -> right f st | ||
78 | _other -> pure st | ||
79 | |||
80 | data InteractInitial | ||
81 | = InitialLeft Text | ||
82 | | InitialRight Text | ||
83 | | InitialEmpty | ||
84 | deriving (Eq, Ord, Show, Read) | ||
85 | |||
86 | makePrisms ''InteractInitial | ||
87 | |||
88 | data InteractConfig c = InteractConfig | ||
89 | { icfgInitial :: InteractInitial | ||
90 | , icfgLens :: EditLens c (StringEdits Natural Char) (StringEdits Natural Char) | ||
91 | , icfgCompileError :: Maybe String | ||
92 | } | ||
93 | |||
94 | instance HasEditLens (InteractConfig c) (StringEdits Natural Char) (StringEdits Natural Char) where | ||
95 | type Complement (InteractConfig c) = c | ||
96 | ground = ground . icfgLens | ||
97 | propR = propR . icfgLens | ||
98 | propL = propL . icfgLens | ||
99 | |||
100 | makeLensesWith abbreviatedFields ''InteractConfig | ||
101 | |||
102 | charseq :: Iso' Text (Seq Char) | ||
103 | charseq = iso Text.unpack Text.pack . iso Seq.fromList Foldable.toList | ||
104 | |||
105 | type InteractEvent = () | ||
106 | |||
107 | type InteractApp c = App (InteractState c) InteractEvent InteractName | ||
108 | |||
109 | data InteractDirection = PropagateLeft | PropagateRight | ||
110 | deriving (Eq, Ord, Enum, Bounded, Show, Read) | ||
111 | |||
112 | makePrisms ''InteractDirection | ||
113 | |||
114 | |||
115 | infixr 1 `WithName` | ||
116 | data WithName x n = WithName x n | ||
117 | deriving (Eq, Ord, Show, Read) | ||
118 | |||
119 | instance Named (x `WithName` n) n where | ||
120 | getName (_ `WithName` n) = n | ||