{-# 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          (share, toInterface)
import CodeWorld.Tasks.Types            (ReifyPicture(..), Shape(..), Style(..))



{- |
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
  reifyResult <- Picture
-> IO (IntMap (ReifyPicture Int), IntMap (ReifyPicture Int))
share Picture
p
  let
    (explicitShares,termIndex) = both IM.toList reifyResult
    (allShares,consTerms) = both toReify $ hashconsShare $ toInterface p
  if length termIndex == length consTerms
    then
      pure Nothing
    else do
      let
        usedBinds = [(Int, ReifyPicture Int)]
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
bindMapping [(Int, ReifyPicture Int)]
explicitShares [(Int, ReifyPicture Int)]
termIndex
        possibleBinds = [(Int, ReifyPicture Int)]
-> [(Int, ReifyPicture Int)] -> [(Int, String)]
bindMapping [(Int, ReifyPicture Int)]
allShares [(Int, ReifyPicture Int)]
consTerms
        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 = ((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 = ((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 = [(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
      pure $ Just $ unlines
        [ "There are opportunities for common subexpression elimination (CSE) in your submission!"
        , "Consider this expression resembling your submission, possibly differing in the following ways:"
        , "  - Subexpressions distributed over multiple definitions have been combined into a single expression"
        , "  - Mathematical subexpressions have been fully evaluated"
        , "  - Some picture related subexpressions might also be fully or partially evaluated."
        , "  - Already defined bindings might have been renamed"
        , "  - Used 'where' bindings have been converted to 'let' bindings"
        , "  - Bindings which are not relevant to CSE have been removed"
        , ""
        , printSharedTerm completeTerm $ termsWithNames usedBinds explicitShares explicit
        , ""
        , ""
        , "It could be rewritten like this:"
        , ""
        , printSharedTerm completeCons $ termsWithNames possibleBinds allShares sharable
        , ""
        , ""
        , "The highlighted terms can be defined globally or locally at their use-site."
        , "For a local definition, you can use either a 'let' or 'where' binding."
        , "Of course, you can also change the proposed names to your liking, e.g. make them more concise."
        , "Also consider that your actual code is most likely " ++
          "structured slightly differently than this suggested improvement."
        , "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 Style
s Double
x Double
y       -> case Style
s of
    Outline Maybe Double
Nothing  -> String
"rectangle"
    Outline (Just Double
t) -> [String] -> String
unwords
      [ String
"thickRectangle"
      , Double -> String
truncatedShow Double
t
      ]
    Style
Solid            -> String
"solidRectangle"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    [ Double -> String
truncatedShow Double
x
    , Double -> String
truncatedShow Double
y
    ]
  Circle Style
s Double
r            -> case Style
s of
    Outline Maybe Double
Nothing  -> String
"circle"
    Outline (Just Double
t) -> [String] -> String
unwords
      [ String
"thickCircle"
      , Double -> String
truncatedShow Double
t
      ]
    Style
Solid            -> String
"solidCircle"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    [
    Double -> String
truncatedShow Double
r
    ]
  Polyline Shape
s [Point]
ps           -> case Shape
s of
    Open Maybe Double
Nothing  -> 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
    Open (Just Double
t) -> 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
    Closed (Outline Maybe Double
Nothing) -> 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
    Closed (Outline (Just Double
t)) -> 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
    Closed Style
Solid -> 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
  Arc Style
s Double
a1 Double
a2 Double
r           -> case Style
s of
    Outline Maybe Double
Nothing -> String
"arc"
    Outline (Just Double
t) -> String
"thickArc " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
truncatedShow Double
t
    Style
Solid -> String
"sector"
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
    [ Double -> String
truncatedShow Double
a1
    , Double -> String
truncatedShow Double
a2
    , Double -> String
truncatedShow Double
r
    ]

  Curve Shape
s [Point]
ps              -> case Shape
s of
    Open Maybe Double
Nothing -> 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
    Open (Just Double
t) -> 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
    Closed (Outline Maybe Double
Nothing) -> 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
    Closed (Outline (Just Double
t)) ->  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
    Closed Style
Solid -> 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 -> Style -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> ReifyPicture a
Rectangle (Maybe Double -> Style
Outline Maybe Double
forall a. Maybe a
Nothing) Double
x Double
y
      ThickRectangleNode Double
t Double
x Double
y -> Style -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> ReifyPicture a
Rectangle (Maybe Double -> Style
Outline (Maybe Double -> Style) -> Maybe Double -> Style
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) Double
x Double
y
      SolidRectangleNode Double
x Double
y -> Style -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> ReifyPicture a
Rectangle Style
Solid Double
x Double
y
      CircleNode Double
r -> Style -> Double -> ReifyPicture Int
forall a. Style -> Double -> ReifyPicture a
Circle (Maybe Double -> Style
Outline Maybe Double
forall a. Maybe a
Nothing) Double
r
      ThickCircleNode Double
t Double
r -> Style -> Double -> ReifyPicture Int
forall a. Style -> Double -> ReifyPicture a
Circle (Maybe Double -> Style
Outline (Maybe Double -> Style) -> Maybe Double -> Style
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) Double
r
      SolidCircleNode Double
r -> Style -> Double -> ReifyPicture Int
forall a. Style -> Double -> ReifyPicture a
Circle Style
Solid Double
r
      PolygonNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Polyline (Style -> Shape
Closed (Style -> Shape) -> Style -> Shape
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Style
Outline Maybe Double
forall a. Maybe a
Nothing) [Point]
ps
      SolidPolygonNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Polyline (Style -> Shape
Closed Style
Solid) [Point]
ps
      ThickPolygonNode Double
t [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Polyline (Style -> Shape
Closed (Style -> Shape) -> Style -> Shape
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Style
Outline (Maybe Double -> Style) -> Maybe Double -> Style
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) [Point]
ps
      ClosedCurveNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Curve (Style -> Shape
Closed (Style -> Shape) -> Style -> Shape
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Style
Outline Maybe Double
forall a. Maybe a
Nothing) [Point]
ps
      SolidClosedCurveNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Curve (Style -> Shape
Closed Style
Solid) [Point]
ps
      ThickClosedCurveNode Double
t [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Curve (Style -> Shape
Closed (Style -> Shape) -> Style -> Shape
forall a b. (a -> b) -> a -> b
$ Maybe Double -> Style
Outline (Maybe Double -> Style) -> Maybe Double -> Style
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) [Point]
ps
      PolylineNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Polyline (Maybe Double -> Shape
Open Maybe Double
forall a. Maybe a
Nothing) [Point]
ps
      ThickPolylineNode Double
t [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Polyline (Maybe Double -> Shape
Open (Maybe Double -> Shape) -> Maybe Double -> Shape
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) [Point]
ps
      CurveNode [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Curve (Maybe Double -> Shape
Open Maybe Double
forall a. Maybe a
Nothing) [Point]
ps
      ThickCurveNode Double
t [Point]
ps -> Shape -> [Point] -> ReifyPicture Int
forall a. Shape -> [Point] -> ReifyPicture a
Curve (Maybe Double -> Shape
Open (Maybe Double -> Shape) -> Maybe Double -> Shape
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t) [Point]
ps
      SectorNode Double
a1 Double
a2 Double
r -> Style -> Double -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> Double -> ReifyPicture a
Arc Style
Solid Double
a1 Double
a2 Double
r
      ArcNode Double
a1 Double
a2 Double
r -> Style -> Double -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> Double -> ReifyPicture a
Arc (Maybe Double -> Style
Outline Maybe Double
forall a. Maybe a
Nothing) Double
a1 Double
a2 Double
r
      ThickArcNode Double
t Double
a1 Double
a2 Double
r -> Style -> Double -> Double -> Double -> ReifyPicture Int
forall a. Style -> Double -> Double -> Double -> ReifyPicture a
Arc (Maybe Double -> Style
Outline (Maybe Double -> Style) -> Maybe Double -> Style
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just 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