{-# language TypeApplications #-}

module CodeWorld.Sharing.Feedback (
  testCSE
) where


import Data.Char                        (isNumber, toLower, toUpper)
import Data.List.Extra                  (intercalate, maximumOn, minimumOn, replace)
import Data.Maybe                       (fromJust)
import Data.Tuple.Extra                 (second, both)
import qualified Data.IntMap            as IM

import CodeWorld                        (Picture)
import CodeWorld.Sharing.HashCons       (BiMap, Node(..), hashconsShare)
import CodeWorld.Tasks.Picture          (ReifyPicture(..), share, toInterface)



{- |
Produce student feedback on common subexpression elimination for a `Picture` value.
This compares the results of the Hashcons and Reify methods to determine unused sharing potential.
Returns `Nothing` if all possible terms are shared.

This runs in an `IO` context, since Reify uses `System.Mem.StableName.StableName` to track sharing.
-}
testCSE :: Picture -> IO (Maybe String)
testCSE :: Picture -> IO (Maybe String)
testCSE Picture
p = do
  (IntMap (ReifyPicture Int), IntMap (ReifyPicture Int))
reifyResult <- Picture
-> IO (IntMap (ReifyPicture Int), IntMap (ReifyPicture Int))
share Picture
p
  let
    ([(Int, ReifyPicture Int)]
explicitShares,[(Int, ReifyPicture Int)]
termIndex) = (IntMap (ReifyPicture Int) -> [(Int, ReifyPicture Int)])
-> (IntMap (ReifyPicture Int), IntMap (ReifyPicture Int))
-> ([(Int, ReifyPicture Int)], [(Int, ReifyPicture Int)])
forall a b. (a -> b) -> (a, a) -> (b, b)
both IntMap (ReifyPicture Int) -> [(Int, ReifyPicture Int)]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap (ReifyPicture Int), IntMap (ReifyPicture Int))
reifyResult
    ([(Int, ReifyPicture Int)]
allShares,[(Int, ReifyPicture Int)]
consTerms) = (BiMap Node -> [(Int, ReifyPicture Int)])
-> (BiMap Node, BiMap Node)
-> ([(Int, ReifyPicture Int)], [(Int, ReifyPicture Int)])
forall a b. (a -> b) -> (a, a) -> (b, b)
both BiMap Node -> [(Int, ReifyPicture Int)]
toReify ((BiMap Node, BiMap Node)
 -> ([(Int, ReifyPicture Int)], [(Int, ReifyPicture Int)]))
-> (BiMap Node, BiMap Node)
-> ([(Int, ReifyPicture Int)], [(Int, ReifyPicture Int)])
forall a b. (a -> b) -> a -> b
$ Runner -> (BiMap Node, BiMap Node)
hashconsShare (Runner -> (BiMap Node, BiMap Node))
-> Runner -> (BiMap Node, BiMap Node)
forall a b. (a -> b) -> a -> b
$ Picture -> Runner
forall a. Drawable a => Picture -> a
toInterface Picture
p
  if [(Int, ReifyPicture Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, ReifyPicture Int)]
termIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Int, ReifyPicture Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, ReifyPicture Int)]
consTerms
    then
      Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
    else do
      let
        usedBinds :: [(Int, String)]
usedBinds = [(Int, ReifyPicture Int)]
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
bindMapping [(Int, ReifyPicture Int)]
explicitShares [(Int, ReifyPicture Int)]
termIndex
        possibleBinds :: [(Int, String)]
possibleBinds = [(Int, ReifyPicture Int)]
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
bindMapping [(Int, ReifyPicture Int)]
allShares [(Int, ReifyPicture Int)]
consTerms
        completeTerm :: String
completeTerm = [(Int, String)]
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int) -> String
forall {a}.
[(Int, String)]
-> [(Int, ReifyPicture Int)] -> (a, ReifyPicture Int) -> String
restoreTerm [(Int, String)]
usedBinds [(Int, ReifyPicture Int)]
termIndex ((Int, ReifyPicture Int) -> String)
-> (Int, ReifyPicture Int) -> String
forall a b. (a -> b) -> a -> b
$ ((Int, ReifyPicture Int) -> Int)
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int)
forall b a. (HasCallStack, Ord b) => (a -> b) -> [a] -> a
minimumOn (Int, ReifyPicture Int) -> Int
forall a b. (a, b) -> a
fst [(Int, ReifyPicture Int)]
termIndex
        explicit :: [String]
explicit = ((Int, ReifyPicture Int) -> String)
-> [(Int, ReifyPicture Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, String)]
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int) -> String
forall {a}.
[(Int, String)]
-> [(Int, ReifyPicture Int)] -> (a, ReifyPicture Int) -> String
restoreTerm [(Int, String)]
usedBinds [(Int, ReifyPicture Int)]
termIndex) [(Int, ReifyPicture Int)]
explicitShares
        sharable :: [String]
sharable = ((Int, ReifyPicture Int) -> String)
-> [(Int, ReifyPicture Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, String)]
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int) -> String
forall {a}.
[(Int, String)]
-> [(Int, ReifyPicture Int)] -> (a, ReifyPicture Int) -> String
restoreTerm [(Int, String)]
possibleBinds [(Int, ReifyPicture Int)]
consTerms) [(Int, ReifyPicture Int)]
allShares
        completeCons :: String
completeCons = [(Int, String)]
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int) -> String
forall {a}.
[(Int, String)]
-> [(Int, ReifyPicture Int)] -> (a, ReifyPicture Int) -> String
restoreTerm [(Int, String)]
possibleBinds [(Int, ReifyPicture Int)]
consTerms ((Int, ReifyPicture Int) -> String)
-> (Int, ReifyPicture Int) -> String
forall a b. (a -> b) -> a -> b
$ ((Int, ReifyPicture Int) -> Int)
-> [(Int, ReifyPicture Int)] -> (Int, ReifyPicture Int)
forall b a. (HasCallStack, Ord b) => (a -> b) -> [a] -> a
maximumOn (Int, ReifyPicture Int) -> Int
forall a b. (a, b) -> a
fst [(Int, ReifyPicture Int)]
consTerms
      Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"There are opportunities for common subexpression elimination (CSE) in your submission!"
        , String
"Consider this expression resembling your submission, possibly differing in the following ways:"
        , String
"  - Subexpressions distributed over multiple definitions have been combined into a single expression"
        , String
"  - Mathematical subexpressions have been fully evaluated"
        , String
"  - Some picture related subexpressions might also be fully or partially evaluated."
        , String
"  - Already defined bindings might have been renamed"
        , String
"  - Used 'where' bindings have been converted to 'let' bindings"
        , String
"  - Bindings which are not relevant to CSE have been removed"
        , String
""
        , String -> [(String, String)] -> String
printSharedTerm String
completeTerm ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [(Int, String)]
-> [(Int, ReifyPicture Int)] -> [String] -> [(String, String)]
forall {b} {a} {b} {b}.
Eq b =>
[(b, a)] -> [(b, b)] -> [b] -> [(a, b)]
termsWithNames [(Int, String)]
usedBinds [(Int, ReifyPicture Int)]
explicitShares [String]
explicit
        , String
""
        , String
""
        , String
"It could be rewritten like this:"
        , String
""
        , String -> [(String, String)] -> String
printSharedTerm String
completeCons ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [(Int, String)]
-> [(Int, ReifyPicture Int)] -> [String] -> [(String, String)]
forall {b} {a} {b} {b}.
Eq b =>
[(b, a)] -> [(b, b)] -> [b] -> [(a, b)]
termsWithNames [(Int, String)]
possibleBinds [(Int, ReifyPicture Int)]
allShares [String]
sharable
        , String
""
        , String
""
        , String
"The highlighted terms can be defined globally or locally at their use-site."
        , String
"For a local definition, you can use either a 'let' or 'where' binding."
        , String
"Of course, you can also change the proposed names to your liking, e.g. make them more concise."
        , String
"Also consider that your actual code is most likely " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          String
"structured slightly differently than this suggested improvement."
        , String
"As such, the location of the binding as shown here might also have to be adjusted."
        ]
  where
    restoreTerm :: [(Int, String)]
-> [(Int, ReifyPicture Int)] -> (a, ReifyPicture Int) -> String
restoreTerm [(Int, String)]
bindings [(Int, ReifyPicture Int)]
termLookup = [(Int, String)]
-> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal [(Int, String)]
bindings [(Int, ReifyPicture Int)]
termLookup (ReifyPicture Int -> String)
-> ((a, ReifyPicture Int) -> ReifyPicture Int)
-> (a, ReifyPicture Int)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ReifyPicture Int) -> ReifyPicture Int
forall a b. (a, b) -> b
snd
    termsWithNames :: [(b, a)] -> [(b, b)] -> [b] -> [(a, b)]
termsWithNames [(b, a)]
bindings [(b, b)]
shares = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((b, b) -> a) -> [(b, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> ((b, b) -> Maybe a) -> (b, b) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> [(b, a)] -> Maybe a) -> [(b, a)] -> b -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> [(b, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(b, a)]
bindings (b -> Maybe a) -> ((b, b) -> b) -> (b, b) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst) [(b, b)]
shares)

    printSharedTerm :: String -> [(String, String)] -> String
printSharedTerm String
term [(String, String)]
shared
      | [(String, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
shared = String
term
      | Bool
otherwise = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        String
"let" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
        ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name,String
value) -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
value) [(String, String)]
shared [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [  String
"in"
        , String -> String
addIndentLevel String
term
        ]


bindMapping :: [(Int,ReifyPicture Int)] -> [(Int,ReifyPicture Int)] -> [(Int,String)]
bindMapping :: [(Int, ReifyPicture Int)]
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
bindMapping [(Int, ReifyPicture Int)]
sharedTerms [(Int, ReifyPicture Int)]
allTerms = ((Int, ReifyPicture Int) -> (Int, String))
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ReifyPicture Int) -> (Int, String)
forall {a}. (a, ReifyPicture Int) -> (a, String)
toName (((Int, ReifyPicture Int) -> Bool)
-> [(Int, ReifyPicture Int)] -> [(Int, ReifyPicture Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, ReifyPicture Int) -> [(Int, ReifyPicture Int)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Int, ReifyPicture Int)]
sharedTerms) [(Int, ReifyPicture Int)]
allTerms)
  where
    toName :: (a, ReifyPicture Int) -> (a, String)
toName = (ReifyPicture Int -> String)
-> (a, ReifyPicture Int) -> (a, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (String -> String
formatBinding (String -> String)
-> (ReifyPicture Int -> String) -> ReifyPicture Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'a'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> (ReifyPicture Int -> String) -> ReifyPicture Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
capitalFirst (String -> String)
-> (ReifyPicture Int -> String) -> ReifyPicture Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, String)]
-> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal [] [(Int, ReifyPicture Int)]
allTerms)

    formatBinding :: String -> String
formatBinding = String -> String
camelCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
keep (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"&" String
"And"

    keep :: Char -> Bool
keep Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'(',Char
')',Char
',',Char
'[',Char
']',Char
'-',Char
'.',Char
'\n'] Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isNumber Char
c)

    capitalFirst :: String -> String
capitalFirst [] = []
    capitalFirst (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

    camelCase :: String -> String
camelCase String
"" = String
""
    camelCase String
" " = String
""
    camelCase (Char
' ':Char
' ':String
s) = String -> String
camelCase (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s
    camelCase (Char
' ':Char
c:String
s) = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCase String
s
    camelCase (Char
c:String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
camelCase String
s

printOriginal :: [(Int,String)] -> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal :: [(Int, String)]
-> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal [(Int, String)]
bindings [(Int, ReifyPicture Int)]
termLookup ReifyPicture Int
term = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ case ReifyPicture Int
term of
  Color Color
c Int
i             ->
    [ String
"colored"
    , (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Color -> String
forall a. Show a => a -> String
parensShow Color
c)
    , Int -> String
printNext Int
i
    ]
  Translate Double
x Double
y Int
i       ->
    [ String
"translated"
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    , Int -> String
printNext Int
i
    ]
  Scale Double
x Double
y Int
i           ->
    [ String
"scaled"
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    , Int -> String
printNext Int
i
    ]
  Dilate Double
fac Int
i          ->
    [ String
"dilated"
    , Double -> String
truncatedShow Double
fac
    , Int -> String
printNext Int
i
    ]
  Rotate Double
a Int
i            ->
    [ String
"rotated"
    , Double -> String
truncatedShow Double
a
    , Int -> String
printNext Int
i
    ]
  Reflect Double
a Int
i           ->
    [ String
"reflected"
    , Double -> String
truncatedShow Double
a
    , Int -> String
printNext Int
i
    ]
  Clip Double
x Double
y Int
i            ->
    [ String
"clipped"
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    , Int -> String
printNext Int
i
    ]
  Pictures [Int]
is           ->
    String -> [String] -> [String]
indentedList String
"pictures" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
printNextAnd [Int]
is
  And Int
i1 Int
i2             ->
    [Int -> String
printNextAnd Int
i1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
printNextAnd Int
i2]
  Rectangle Double
x Double
y         ->
    [ String
"rectangle"
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    ]
  ThickRectangle Double
t Double
x Double
y  ->
    [ String
"thickRectangle"
    , Double -> String
truncatedShow Double
t
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    ]
  SolidRectangle Double
x Double
y    ->
    [ String
"solidRectangle"
    , Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    ]
  Circle Double
r              ->
    [String
"circle " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
r]
  ThickCircle Double
t Double
r       ->
    [ String
"thickCircle"
    , Double -> String
truncatedShow Double
t
    , Double -> String
truncatedShow Double
r
    ]
  SolidCircle Double
r         ->
    [String
"solidCircle " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
r]
  Polygon [Point]
ps            ->
    String -> [String] -> [String]
indentedList String
"polygon" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  ThickPolygon Double
t [Point]
ps     ->
    String -> [String] -> [String]
indentedList (String
"thickPolygon " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
t) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  SolidPolygon [Point]
ps       ->
    String -> [String] -> [String]
indentedList String
"solidPolygon" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  Polyline [Point]
ps           ->
    String -> [String] -> [String]
indentedList String
"polyline" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  ThickPolyline Double
t [Point]
ps    ->
    String -> [String] -> [String]
indentedList (String
"thickPolyline " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
t) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  Sector Double
a1 Double
a2 Double
r        ->
    [ String
"sector"
    , Double -> String
truncatedShow Double
a1
    , Double -> String
truncatedShow Double
a2
    , Double -> String
truncatedShow Double
r
    ]
  Arc Double
a1 Double
a2 Double
r           ->
    [ String
"arc"
    , Double -> String
truncatedShow Double
a1
    , Double -> String
truncatedShow Double
a2
    , Double -> String
truncatedShow Double
r
    ]
  ThickArc Double
t Double
a1 Double
a2 Double
r    ->
    [ String
"thickArc"
    , Double -> String
truncatedShow Double
t
    , Double -> String
truncatedShow Double
a1
    , Double -> String
truncatedShow Double
a2
    , Double -> String
truncatedShow Double
r
    ]
  Curve [Point]
ps              ->
    String -> [String] -> [String]
indentedList String
"curve" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  ThickCurve Double
t [Point]
ps       ->
    String -> [String] -> [String]
indentedList (String
"thickCurve " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
t) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  ClosedCurve [Point]
ps        ->
    String -> [String] -> [String]
indentedList String
"closedCurve" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  ThickClosedCurve Double
t [Point]
ps ->
    String -> [String] -> [String]
indentedList (String
"thickClosedCurve " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
t) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  SolidClosedCurve [Point]
ps   ->
    String -> [String] -> [String]
indentedList String
"solidClosedCurve" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Point -> String) -> [Point] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point -> String
forall a. Show a => a -> String
show [Point]
ps
  Lettering Text
t           ->
    [String
"lettering " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t]
  StyledLettering TextStyle
s Font
f Text
t ->
    [ String
"styledLettering"
    , TextStyle -> String
forall a. Show a => a -> String
show TextStyle
s
    , Font -> String
forall a. Show a => a -> String
show Font
f
    , Text -> String
forall a. Show a => a -> String
show Text
t
    ]
  ReifyPicture Int
CoordinatePlane       ->
    [String
"coordinatePlane"]
  ReifyPicture Int
Logo                  ->
    [String
"codeWorldLogo"]
  ReifyPicture Int
Blank                 ->
    [String
"blank"]

  where
    printNext :: Int -> String
    printNext :: Int -> String
printNext Int
i = case Int -> [(Int, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, String)]
bindings of
      Maybe String
Nothing
          | ReifyPicture Int -> Bool
forall a. ReifyPicture a -> Bool
hasArguments ReifyPicture Int
reifyPic -> String
result
          | Bool
otherwise             -> String
originalTerm
        where reifyPic :: ReifyPicture Int
reifyPic = Maybe (ReifyPicture Int) -> ReifyPicture Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (ReifyPicture Int) -> ReifyPicture Int)
-> Maybe (ReifyPicture Int) -> ReifyPicture Int
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, ReifyPicture Int)] -> Maybe (ReifyPicture Int)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, ReifyPicture Int)]
termLookup
              originalTerm :: String
originalTerm = [(Int, String)]
-> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal [(Int, String)]
bindings [(Int, ReifyPicture Int)]
termLookup ReifyPicture Int
reifyPic
              result :: String
result = if Char
'&' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
originalTerm Bool -> Bool -> Bool
|| String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
originalTerm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLineWidth
                then String
"(\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
addIndentLevel String
originalTerm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                else String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
originalTerm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      Just String
name -> String
name

    printNextAnd :: Int -> String
    printNextAnd :: Int -> String
printNextAnd Int
i = case Int -> [(Int, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, String)]
bindings of
      Maybe String
Nothing -> [(Int, String)]
-> [(Int, ReifyPicture Int)] -> ReifyPicture Int -> String
printOriginal [(Int, String)]
bindings [(Int, ReifyPicture Int)]
termLookup (ReifyPicture Int -> String) -> ReifyPicture Int -> String
forall a b. (a -> b) -> a -> b
$ Maybe (ReifyPicture Int) -> ReifyPicture Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (ReifyPicture Int) -> ReifyPicture Int)
-> Maybe (ReifyPicture Int) -> ReifyPicture Int
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, ReifyPicture Int)] -> Maybe (ReifyPicture Int)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, ReifyPicture Int)]
termLookup
      Just String
name -> String
name

    roundTo :: Integer -> Double -> Double
    roundTo :: Integer -> Double -> Double
roundTo Integer
places Double
d = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fac) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fac
      where fac :: Double
fac = Double
10Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
places

    parensShow :: Show a => a -> String
    parensShow :: forall a. Show a => a -> String
parensShow = String -> String
optParens (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

    truncatedShow :: Double -> String
truncatedShow = String -> String
optParens (String -> String) -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reSubPi (String -> String) -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double -> Double
roundTo Integer
3

    optParens :: String -> String
optParens String
s
      | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
words String
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1  Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) String
"-/*" = Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      | Bool
otherwise = String
s

    reSubPi :: String -> String
reSubPi String
"3.141" = String
"pi"
    reSubPi String
"1.570" = String
"pi/2"
    reSubPi String
"0.785" = String
"pi/4"
    reSubPi String
"4.712" = String
"3*pi/2"
    reSubPi String
"2.356" = String
"3*pi/4"
    reSubPi (Char
'-':String
s) = Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
reSubPi String
s
    reSubPi String
s       = String
s


addIndentLevel :: String -> String
addIndentLevel :: String -> String
addIndentLevel = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines


maxLineWidth :: Int
maxLineWidth :: Int
maxLineWidth = Int
80


indentedList :: String -> [String] -> [String]
indentedList :: String -> [String] -> [String]
indentedList String
name [String]
xs =
  [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n  ["
  , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n  , " [String]
xs
  , String
"\n  ]"
  ]


hasArguments :: ReifyPicture a -> Bool
hasArguments :: forall a. ReifyPicture a -> Bool
hasArguments ReifyPicture a
Blank           = Bool
False
hasArguments ReifyPicture a
CoordinatePlane = Bool
False
hasArguments ReifyPicture a
Logo            = Bool
False
hasArguments ReifyPicture a
_               = Bool
True


toReify :: BiMap Node -> [(IM.Key, ReifyPicture Int)]
toReify :: BiMap Node -> [(Int, ReifyPicture Int)]
toReify = ((Int, Node) -> (Int, ReifyPicture Int))
-> BiMap Node -> [(Int, ReifyPicture Int)]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Node) -> (Int, ReifyPicture Int))
 -> BiMap Node -> [(Int, ReifyPicture Int)])
-> ((Int, Node) -> (Int, ReifyPicture Int))
-> BiMap Node
-> [(Int, ReifyPicture Int)]
forall a b. (a -> b) -> a -> b
$ (Node -> ReifyPicture Int)
-> (Int, Node) -> (Int, ReifyPicture Int)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second Node -> ReifyPicture Int
toReifyPic
  where
    toReifyPic :: Node -> ReifyPicture Int
toReifyPic Node
n = case Node
n of
      RectangleNode Double
x Double
y -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> ReifyPicture a
Rectangle Double
x Double
y
      ThickRectangleNode Double
t Double
x Double
y -> Double -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> Double -> ReifyPicture a
ThickRectangle Double
t Double
x Double
y
      SolidRectangleNode Double
x Double
y -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> ReifyPicture a
SolidRectangle Double
x Double
y
      CircleNode Double
r -> Double -> ReifyPicture Int
forall a. Double -> ReifyPicture a
Circle Double
r
      ThickCircleNode Double
t Double
r -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> ReifyPicture a
ThickCircle Double
t Double
r
      SolidCircleNode Double
r -> Double -> ReifyPicture Int
forall a. Double -> ReifyPicture a
SolidCircle Double
r
      PolygonNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
Polygon [Point]
ps
      SolidPolygonNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
SolidPolygon [Point]
ps
      ThickPolygonNode Double
t [Point]
ps -> Double -> [Point] -> ReifyPicture Int
forall a. Double -> [Point] -> ReifyPicture a
ThickPolygon Double
t [Point]
ps
      ClosedCurveNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
ClosedCurve [Point]
ps
      SolidClosedCurveNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
SolidClosedCurve [Point]
ps
      ThickClosedCurveNode Double
t [Point]
ps -> Double -> [Point] -> ReifyPicture Int
forall a. Double -> [Point] -> ReifyPicture a
ThickClosedCurve Double
t [Point]
ps
      PolylineNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
Polyline [Point]
ps
      ThickPolylineNode Double
t [Point]
ps -> Double -> [Point] -> ReifyPicture Int
forall a. Double -> [Point] -> ReifyPicture a
ThickPolyline Double
t [Point]
ps
      CurveNode [Point]
ps -> [Point] -> ReifyPicture Int
forall a. [Point] -> ReifyPicture a
Curve [Point]
ps
      ThickCurveNode Double
t [Point]
ps -> Double -> [Point] -> ReifyPicture Int
forall a. Double -> [Point] -> ReifyPicture a
ThickCurve Double
t [Point]
ps
      SectorNode Double
a1 Double
a2 Double
r -> Double -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> Double -> ReifyPicture a
Sector Double
a1 Double
a2 Double
r
      ArcNode Double
a1 Double
a2 Double
r -> Double -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> Double -> ReifyPicture a
Arc Double
a1 Double
a2 Double
r
      ThickArcNode Double
t Double
a1 Double
a2 Double
r -> Double -> Double -> Double -> Double -> ReifyPicture Int
forall a. Double -> Double -> Double -> Double -> ReifyPicture a
ThickArc Double
t Double
a1 Double
a2 Double
r
      LetteringNode Text
t -> Text -> ReifyPicture Int
forall a. Text -> ReifyPicture a
Lettering Text
t
      StyledLetteringNode TextStyle
ts Font
f Text
t -> TextStyle -> Font -> Text -> ReifyPicture Int
forall a. TextStyle -> Font -> Text -> ReifyPicture a
StyledLettering TextStyle
ts Font
f Text
t
      ColorNode Color
c Int
p -> Color -> Int -> ReifyPicture Int
forall a. Color -> a -> ReifyPicture a
Color Color
c Int
p
      TranslateNode Double
x Double
y Int
p -> Double -> Double -> Int -> ReifyPicture Int
forall a. Double -> Double -> a -> ReifyPicture a
Translate Double
x Double
y Int
p
      ScaleNode Double
x Double
y Int
p -> Double -> Double -> Int -> ReifyPicture Int
forall a. Double -> Double -> a -> ReifyPicture a
Scale Double
x Double
y Int
p
      DilateNode Double
fac Int
p -> Double -> Int -> ReifyPicture Int
forall a. Double -> a -> ReifyPicture a
Dilate Double
fac Int
p
      RotateNode Double
a Int
p -> Double -> Int -> ReifyPicture Int
forall a. Double -> a -> ReifyPicture a
Rotate Double
a Int
p
      ReflectNode Double
a Int
p -> Double -> Int -> ReifyPicture Int
forall a. Double -> a -> ReifyPicture a
Reflect Double
a Int
p
      ClipNode Double
x Double
y Int
p -> Double -> Double -> Int -> ReifyPicture Int
forall a. Double -> Double -> a -> ReifyPicture a
Clip Double
x Double
y Int
p
      PicturesNode [Int]
ps -> [Int] -> ReifyPicture Int
forall a. [a] -> ReifyPicture a
Pictures [Int]
ps
      AndNode Int
p1 Int
p2 -> Int -> Int -> ReifyPicture Int
forall a. a -> a -> ReifyPicture a
And Int
p1 Int
p2
      Node
CoordinatePlaneNode -> ReifyPicture Int
forall a. ReifyPicture a
CoordinatePlane
      Node
LogoNode -> ReifyPicture Int
forall a. ReifyPicture a
Logo
      Node
BlankNode -> ReifyPicture Int
forall a. ReifyPicture a
Blank