sugar for data and other improvements
- parse types in let (everything but parser was there) - add sugar for `data` - move `joinBy` to prelude - fix highlighting for char in vscode - better errors for missing imports
This commit is contained in:
@@ -14,7 +14,7 @@ import Prelude
|
||||
data Doc : U where
|
||||
Empty Line : Doc
|
||||
Text : String -> Doc
|
||||
Nest : Nat -> Doc -> Doc
|
||||
Nest : Int -> Doc -> Doc
|
||||
Seq : Doc -> Doc -> Doc
|
||||
Alt : Doc -> Doc -> Doc
|
||||
|
||||
@@ -24,7 +24,7 @@ data Doc : U where
|
||||
-- data Item = TEXT String | LINE Nat
|
||||
data Item : U where
|
||||
TEXT : String -> Item
|
||||
LINE : Nat -> Item
|
||||
LINE : Int -> Item
|
||||
|
||||
empty : Doc
|
||||
empty = Empty
|
||||
@@ -43,13 +43,13 @@ group x = Alt (flatten x) x
|
||||
-- TODO - we can accumulate snoc and cat all at once
|
||||
layout : List Item -> SnocList String -> String
|
||||
layout Nil acc = fastConcat $ acc <>> Nil
|
||||
layout (LINE k :: x) acc = layout x (acc :< "\n" :< replicate k ' ')
|
||||
layout (LINE k :: x) acc = layout x (acc :< "\n" :< replicate (cast k) ' ')
|
||||
layout (TEXT str :: x) acc = layout x (acc :< str)
|
||||
|
||||
-- Whether a documents first line fits.
|
||||
fits : Nat -> List Item -> Bool
|
||||
fits : Int -> List Item -> Bool
|
||||
fits 0 x = False
|
||||
fits w ((TEXT s) :: xs) = fits (w - length s) xs
|
||||
fits w ((TEXT s) :: xs) = fits (w - slen s) xs
|
||||
fits w _ = True
|
||||
|
||||
-- vs Wadler, we're collecting the left side as a SnocList to prevent
|
||||
@@ -58,21 +58,21 @@ fits w _ = True
|
||||
|
||||
-- I've now added a `fit` boolean to indicate if we should cut when we hit the line length
|
||||
-- Wadler was relying on laziness to stop the first branch before LINE if necessary
|
||||
be : Bool -> SnocList Item -> Nat -> Nat -> List (Nat × Doc) -> Maybe (List Item)
|
||||
be : Bool -> SnocList Item -> Int -> Int -> List (Int × Doc) -> Maybe (List Item)
|
||||
be fit acc w k Nil = Just (acc <>> Nil)
|
||||
be fit acc w k ((i, Empty) :: xs) = be fit acc w k xs
|
||||
be fit acc w k ((i, Line) :: xs) = (be False (acc :< LINE i) w i xs)
|
||||
be fit acc w k ((i, (Text s)) :: xs) =
|
||||
case not fit || (k + length s < w) of
|
||||
True => (be fit (acc :< TEXT s) w (k + length s) xs)
|
||||
case not fit || (k + slen s < w) of
|
||||
True => (be fit (acc :< TEXT s) w (k + slen s) xs)
|
||||
False => Nothing
|
||||
be fit acc w k ((i, (Nest j x)) :: xs) = be fit acc w k ((i + j, x):: xs)
|
||||
be fit acc w k ((i, (Seq x y)) :: xs) = be fit acc w k ((i,x) :: (i,y) :: xs)
|
||||
be fit acc w k ((i, (Alt x y)) :: xs) =
|
||||
(_<>>_ acc) <$> (be True Lin w k ((i,x) :: xs) <|> be fit Lin w k ((i, y) :: xs))
|
||||
|
||||
best : Nat -> Nat -> Doc -> List Item
|
||||
best w k x = fromMaybe Nil $ be False Lin w k ((Z,x) :: Nil)
|
||||
best : Int -> Int -> Doc -> List Item
|
||||
best w k x = fromMaybe Nil $ be False Lin w k ((0,x) :: Nil)
|
||||
|
||||
-- interface Pretty a where
|
||||
-- pretty : a -> Doc
|
||||
@@ -83,8 +83,8 @@ data Pretty : U -> U where
|
||||
pretty : {a} {{Pretty a}} → a → Doc
|
||||
pretty {{MkPretty p}} x = p x
|
||||
|
||||
render : Nat -> Doc -> String
|
||||
render w x = layout (best w Z x) Lin
|
||||
render : Int -> Doc -> String
|
||||
render w x = layout (best w 0 x) Lin
|
||||
|
||||
instance Semigroup Doc where
|
||||
x <+> y = Seq x (Seq (Text " ") y)
|
||||
@@ -97,7 +97,7 @@ line = Line
|
||||
text : String -> Doc
|
||||
text = Text
|
||||
|
||||
nest : Nat -> Doc -> Doc
|
||||
nest : Int -> Doc -> Doc
|
||||
nest = Nest
|
||||
|
||||
instance Concat Doc where
|
||||
@@ -123,7 +123,7 @@ stack = folddoc _</>_
|
||||
|
||||
-- bracket x with l and r, indenting contents on new line
|
||||
bracket : String -> Doc -> String -> Doc
|
||||
bracket l x r = group (text l ++ nest (S (S Z)) (line ++ x) ++ line ++ text r)
|
||||
bracket l x r = group (text l ++ nest 2 (line ++ x) ++ line ++ text r)
|
||||
|
||||
infixl 5 _<+/>_
|
||||
|
||||
@@ -138,7 +138,7 @@ fill Nil = Empty
|
||||
fill (x :: Nil) = x
|
||||
fill (x :: y :: xs) = Alt (flatten x <+> fill (flatten y :: xs)) (x </> fill (y :: xs))
|
||||
|
||||
-- separate with space
|
||||
-- separate with comma
|
||||
commaSep : List Doc -> Doc
|
||||
commaSep = folddoc (\a b => a ++ text "," <+/> b)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user