unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-05 06:07:21 +03:00
Code Issues Projects Releases Wiki Activity

cleanup, and move Rendered to ColorText

Browse Source
This commit is contained in:
Arya Irani 2018-10-27 17:01:52 -04:00
parent a92dcb2c80
commit ff951da9b8
6 changed files with 94 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
parser-typechecker/src/Unison/Codebase/Watch.hs
View File

@ -23,7 +23,6 @@ import System.FSNotify (Event (Added, Modified), watchTree,
import qualified Unison.FileParsers as FileParsers
import qualified Unison.Parser as Parser
import qualified Unison.Parsers as Parsers
-- import Unison.Util.AnnotatedText (renderTextUnstyled)
import Control.Exception (finally)
import System.Random (randomIO)
import Unison.Codebase (Codebase)

58
parser-typechecker/src/Unison/PrintError.hs
View File

@ -13,58 +13,48 @@ module Unison.PrintError where
-- import Unison.Parser (showLineCol)
-- import Unison.Util.Monoid (whenM)
import Control.Lens ((%~))
import Control.Lens.Tuple (_1, _2, _3)
import Control.Monad (join)
import Control.Lens ( (%~) )
import Control.Lens.Tuple ( _1
, _2
, _3
)
import qualified Data.Char as Char
import Data.Foldable
import Data.List ( intersperse, sortOn )
import Data.List (intersperse, sortOn)
import qualified Data.List.NonEmpty as Nel
import Data.Map ( Map )
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe ( catMaybes
, fromMaybe
)
import Data.Sequence ( Seq(..) )
import Data.Maybe (catMaybes, fromMaybe)
import Data.Sequence (Seq (..))
import qualified Data.Set as Set
import Data.String ( IsString
, fromString
)
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text ( Text )
import Data.Void ( Void )
import Data.Void (Void)
import Debug.Trace
import qualified Text.Megaparsec as P
import qualified Unison.ABT as ABT
import Unison.Kind ( Kind )
import qualified Unison.DataDeclaration as DD
import Unison.Kind (Kind)
import qualified Unison.Kind as Kind
import qualified Unison.Lexer as L
import Unison.Parser ( Ann(..)
, Annotated
, ann
)
import Unison.Parser (Ann (..), Annotated, ann)
import qualified Unison.Parser as Parser
import qualified Unison.Reference as R
import Unison.Result ( Note(..) )
import Unison.Result (Note (..))
import qualified Unison.Settings as Settings
import qualified Unison.Type as Type
import qualified Unison.Term as Term
import qualified Unison.TypeVar as TypeVar
import qualified Unison.Type as Type
import qualified Unison.Typechecker.Context as C
import Unison.Typechecker.TypeError
import qualified Unison.Util.AnnotatedText as AT
import Unison.Util.AnnotatedText (AnnotatedText, Rendered)
import Unison.Util.ColorText ( Color, ANSI )
import qualified Unison.Util.ColorText as Color
import Unison.Util.Monoid ( intercalateMap )
import Unison.Util.Range ( Range(..) )
import Unison.Var ( Var )
import qualified Unison.Var as Var
import qualified Unison.TypeVar as TypeVar
import qualified Unison.UnisonFile as UF
import qualified Unison.DataDeclaration as DD
import Unison.Util.AnnotatedText (AnnotatedText)
import qualified Unison.Util.AnnotatedText as AT
import Unison.Util.ColorText (ANSI, Color, Rendered)
import qualified Unison.Util.ColorText as Color
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Range (Range (..))
import Unison.Var (Var)
import qualified Unison.Var as Var
data Env = Env { referenceNames :: Map R.Reference String
, constructorNames :: Map (R.Reference, Int) String }
@ -120,7 +110,7 @@ styleAnnotated :: Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated sty a = (, sty) <$> rangeForAnnotated a
style :: s -> String -> AnnotatedText s
style sty str = AT.pairToText' (str, sty)
style sty str = AT.annotate sty str
describeStyle :: Color -> AnnotatedText Color
describeStyle ErrorSite = "in " <> style ErrorSite "red"

39
parser-typechecker/src/Unison/Util/AnnotatedText.hs
View File

@ -8,19 +8,19 @@
module Unison.Util.AnnotatedText where
import Data.Foldable (asum, foldl')
import Data.Foldable (foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq ((:|>)))
import qualified Data.Sequence as Seq
import Data.String (IsString (..))
import Data.Void (Void)
import Safe (headMay, lastMay)
import Unison.Lexer (Line, Pos (..))
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Range (Range (..), inRange)
type AnnotatedText a = AnnotatedText' (Maybe a)
newtype AnnotatedText' a = AnnotatedText' (Seq (String, a))
deriving (Functor, Foldable, Semigroup, Monoid)
@ -31,14 +31,20 @@ data AnnotatedExcerpt a = AnnotatedExcerpt
, annotations :: Map Range a
} deriving (Functor)
newtype Rendered a = Rendered { rawRender :: Seq String }
deriving (Semigroup, Monoid)
annotate :: a -> String -> AnnotatedText a
annotate a str = AnnotatedText' . Seq.singleton $ (str, Just a)
pairToText :: (String, a) -> AnnotatedText' a
pairToText (str, a) = AnnotatedText' . Seq.singleton $ (str, a)
annotate' :: a -> String -> AnnotatedText' a
annotate' a str = AnnotatedText' . Seq.singleton $ (str, a)
pairToText' :: (String, a) -> AnnotatedText a
pairToText' (str, a) = pairToText (str, Just a)
deannotate :: AnnotatedText a -> AnnotatedText b
deannotate t = const Nothing <$> t
reannotate :: a -> AnnotatedText a -> AnnotatedText a
reannotate a t = fmap (const a) <$> t
reannotate' :: a -> AnnotatedText' a -> AnnotatedText' a
reannotate' a t = const a <$> t
trailingNewLine :: AnnotatedText a -> Bool
trailingNewLine (AnnotatedText' (init :|> (s,_))) =
@ -51,12 +57,13 @@ trailingNewLine _ = False
markup :: AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
markup a r = a { annotations = r `Map.union` annotations a }
renderTextUnstyled :: AnnotatedText' a -> Rendered Void
renderTextUnstyled (AnnotatedText' chunks) = foldl' go mempty chunks
where go r (text, _) = r <> fromString text
-- renderTextUnstyled :: AnnotatedText' a -> Rendered Void
-- renderTextUnstyled (AnnotatedText' chunks) = foldl' go mempty chunks
-- where go r (text, _) = r <> fromString text
textLength :: AnnotatedText' a -> Int
textLength = length . show . renderTextUnstyled
textLength (AnnotatedText' chunks) = foldl' go 0 chunks
where go len (text, _a) = len + length text
textEmpty :: AnnotatedText' a -> Bool
textEmpty = (==0) . textLength
@ -95,7 +102,7 @@ excerptToText e =
(additions, pos') =
if c == '\n'
then ("\n" <> renderLineNumber (line + 1), Pos (line + 1) 1)
else (pairToText ([c], maybeColor), Pos line (col + 1))
else (annotate' maybeColor [c], Pos line (col + 1))
in track pos' stack' remainingAnnotations (rendered <> additions) rest
snipWithContext :: Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
@ -142,9 +149,3 @@ instance IsString (AnnotatedText a) where
instance IsString (AnnotatedExcerpt a) where
fromString s = AnnotatedExcerpt 1 s mempty
instance Show (Rendered a) where
show (Rendered chunks) = asum chunks
instance IsString (Rendered a) where
fromString s = Rendered (pure s)

31
parser-typechecker/src/Unison/Util/ColorText.hs
View File

@ -1,16 +1,21 @@
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module Unison.Util.ColorText (ANSI, Color (..), style, renderText)
module Unison.Util.ColorText (ANSI, Color (..), ColorText, Rendered, style, renderText)
where
import Data.Foldable (foldl')
import Data.Foldable (asum, foldl')
import Data.Sequence (Seq)
import Data.String (IsString (..))
import qualified System.Console.ANSI as ANSI
import Unison.Util.AnnotatedText (AnnotatedText, AnnotatedText' (..),
Rendered (..))
import Unison.Util.AnnotatedText (AnnotatedText,
pattern AnnotatedText', reannotate)
type ColorText = AnnotatedText Color
data ANSI
@ -20,13 +25,10 @@ data Color
| Bold
deriving (Eq, Ord, Bounded, Enum, Show, Read)
_unhighlighted :: AnnotatedText a -> AnnotatedText a
_unhighlighted s = const Nothing <$> s
style :: Color -> ColorText -> ColorText
style = reannotate
style :: a -> AnnotatedText a -> AnnotatedText a
style c s = const (Just c) <$> s
renderText :: AnnotatedText Color -> Rendered ANSI
renderText :: ColorText -> Rendered ANSI
renderText (AnnotatedText' chunks) =
(snd $ foldl' go (Nothing, mempty) chunks) <> resetANSI
where go :: (Maybe Color, Rendered ANSI) -> (String, Maybe Color) -> (Maybe Color, Rendered ANSI)
@ -58,3 +60,12 @@ renderText (AnnotatedText' chunks) =
HiCyan -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Cyan]
HiWhite -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White]
Bold -> [ANSI.SetConsoleIntensity ANSI.BoldIntensity]
newtype Rendered a = Rendered { _rawRender :: Seq String }
deriving (Semigroup, Monoid)
instance Show (Rendered a) where
show (Rendered chunks) = asum chunks
instance IsString (Rendered ANSI) where
fromString s = Rendered (pure s)

8
parser-typechecker/src/Unison/Util/Menu.hs
View File

@ -14,13 +14,13 @@ import Data.String (IsString, fromString)
import Data.Strings (strPadLeft)
import Safe (atMay)
import qualified Text.Read as Read
import Unison.Util.AnnotatedText (AnnotatedText, textEmpty)
import Unison.Util.ColorText (Color, renderText)
import Unison.Util.AnnotatedText (textEmpty)
import Unison.Util.ColorText (ColorText, renderText)
import Unison.Util.Monoid (intercalateMap)
-- utility - command line menus
type Caption = AnnotatedText Color
type Stylized = AnnotatedText Color
type Caption = ColorText
type Stylized = ColorText
type Keyword = String
type Console = IO String

4
parser-typechecker/tests/Unison/Test/ColorText.hs
View File

@ -7,9 +7,9 @@ import qualified Data.Map as Map
import EasyTest
import Text.RawString.QQ
import Unison.Lexer (Pos (..))
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..), Rendered,
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..),
condensedExcerptToText, markup)
import Unison.Util.ColorText (ANSI, Color (..), renderText)
import Unison.Util.ColorText (ANSI, Color (..), Rendered, renderText)
import qualified Unison.Util.ColorText as ColorText
import Unison.Util.Range (Range (..))